vba Copy Paste Conditional to put remark 1 2 3 .. etc

**fixer** · 05-01-2020, 12:19 AM

Thnx Alot Molly Mam for helping me in solving this problem
Have a Great Day
U have mentioned that ignore that post so till today i have not checked that code but today i thought to check the code if there will be any error i will try to solve it
But the code was perfect

Code:

'  http://www.excelfox.com/forum/showthread.php/2465-copy-paste-conditional


Sub CopyPasterConditionalToPutRemark_1_2_3_etc() '
Rem 1 Worksheets info
Dim Wb1 As Workbook, Wb2 As Workbook, Ws1 As Worksheet, Ws2 As Worksheet
 Set Wb1 = Workbooks("1.xlsx")
 Set Wb2 = ThisWorkbook   '   macro will be placed in 2.xlsm
 Set Ws1 = Wb1.Worksheets.Item(1): Set Ws2 = Wb2.Worksheets.Item(1)
Rem 2 data Input
Dim arr1() As Variant, arr2() As Variant, arr3() As Variant
 Let arr1() = Ws1.Range("A1:K" & Ws1.Range("A1").CurrentRegion.Rows.Count & "").Value
 Let arr2() = Ws2.Range("A1").CurrentRegion.Value                                     ' Current region will not work for arrS1() because columns G to J are empty
'2b
 ReDim arr3(0 To UBound(arr2(), 1)) ' A 1 dimension array of arrays , ( the first element arr3(0) we will not use )
''2b(i)
' Let arrS3(1) = Ws3.Range("A" & Ws3.Range("A1").CurrentRegion.Columns.Count & "") ' header row as a one dimensional array
''2b(ii) data rows array output
Rem 3
Dim Cnt
    For Cnt = 2 To UBound(arr2(), 1) '  "row" count, Cnt from after heading untill last row in  2.xlsm ( Ws2 )
    '2b)(ii) make and fill the row element array inside the current arr3(cnt) element
    Dim Lc As Long: Let Lc = Ws2.Cells.Item(Cnt, Ws2.Cells.Columns.Count).End(xlToLeft).Column ' last column in this row cnt
     Let arr3(Cnt - 1) = Ws2.Range("A" & Cnt & ":" & CL(Lc + 1) & Cnt & "").Value ' - returns an array of 1 "row" into this element of the array of arrays. It has one more element than filled columns - this empty last element is filled in the next line
     Let arr3(Cnt - 1)(1, UBound(arr3(Cnt - 1), 2)) = UBound(arr3(Cnt - 1), 2) - 2 ' this puts the next integer in the last, currently empty element
    '3a) Check for match criteria
    Dim mtchRes As Variant
     Let mtchRes = Application.Match(arr2(Cnt, 2), Ws1.Range("B1:B" & UBound(arr1(), 1) & ""), 0)
        If IsError(mtchRes) Then  '  If the last line errored than we did not find a match, so from the 3rd up to the last element need to be rtemoved from the array for this row
        Dim Empt As Long
            For Empt = 3 To UBound(arr3(Cnt - 1), 2)
             Let arr3(Cnt - 1)(1, Empt) = ""
            Next Empt
        Else
        ' a match was found, so we do not need to remove the  1   2   3   etc...
        End If
    '3c) Paste out row
     Let Ws2.Range("A" & Cnt & "").Resize(1, Lc + 1).Value = arr3(Cnt - 1)
    Next Cnt
                                                                                                                        Rem 4    ....and after putting the remark clear sheet 1 and sheet 2
                                                                                                                        ' Ws1.Cells.Clear
                                                                                                                        ' Ws2.Cells.Clear
End Sub



















'     http://www.excelfox.com/forum/showthread.php/1546-TESTING-Column-Letter-test-Sort
Public Function CL(ByVal lclm As Long) As String '         http://www.excelforum.com/development-testing-forum/1101544-thread-post-appendix-no-reply-needed-please-do-not-delete-thanks-4.html#post4213980
    Do: Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL: Let lclm = (lclm - (1)) \ 26: Loop While lclm > 0
End Function

I used this vba code and it is giving perfect output if any error u know plz let me know
for me it is working perfect as per my needs

**fixer** · 05-01-2020, 10:41 AM

I am really Sorry Molly Mam its was my fault
little modification in the code is required
plz see the sample file

**Molly Brennholz** · 05-01-2020, 06:15 PM

Hello.

Originally Posted by fixer

...U have mentioned that ignore that post so till today i have not checked that code but today i thought to check the code if there will be any error i will try to solve it .....

I am not really sure what you are saying here.
I am sorry, but I do not understand you very well.
I think you have difficulty speaking in English.
( Just out of interest, where do you come from?. What is your mother tongue? Have you tried this https://translate.google.de/?hl=de#v...te&sl=hi&tl=en )

Originally Posted by fixer

.. little modification in the code is required
plz see the sample file

This was last macro …
If column B of 2.xlsm match with column B of 1.xls then paste the data from column C of 2.xls as 1,2,3,4,5 and so on....
&
If column B of 2.xlsm doesn't match with column B of 1.xls then delete all the data from column C of that row

Code:

        If IsError(mtchRes) Then  '  If the last line errored than we did not find a match, so from the 3rd up to the last element need to be removed from the array for this row
        Dim Empt As Long
            For Empt = 3 To UBound(arr3(Cnt - 1), 2)
             Let arr3(Cnt - 1)(1, Empt) = ""
            Next Empt
        Else
        ' a match was found, so we do not need to remove the  1   2   3   etc...
        End If

_.______________________

This is new requirement…
If column B of 2.xlsm match with column B of 1.xls then clear all the data in that row from column C
If column B of 2.xlsm does not match with column B of 1.xls then paste the data from column C of 2.xls as 1,2,3,4,5 and so on…
New requirement is almost the same, but it is just now
The other way around,
or
Upside down
or,
Standing on its head,
or
Arse over Tit

Code:

        If IsError(mtchRes) Then  '  If the last line errored than we did not find a match, so we do not need to  do anything to the array
        ' a match was not found, so we do not need to remove the  1   2   3   etc...
        Else
        ' a match was found, so we need to remove the  1   2   3   etc...
        Dim Empt As Long
            For Empt = 3 To UBound(arr3(Cnt - 1), 2)
             Let arr3(Cnt - 1)(1, Empt) = ""
            Next Empt
        End If

( Full macro is here:
Sub CopyPasterConditionalToPutRemark_1_2_3_etcArseOverTit() http://www.excelfox.com/forum/showth...ll=1#post13176 )

Before:
_____ Workbook: 1 1mai.xlsx ( Using Excel 2007 32 bit )

_Row\^Col	A	B	C	D	E	F
1	NSE	15083	6	>	70000	A
2	NSE	17388	6	>	20000	A
3	NSE	100	6	>	170000	A
4

Worksheet: Sheet1

_____ Workbook: 2 1Mai.xlsm ( Using Excel 2007 32 bit )

_Row\^Col	A	B	C	D	E	F	G	H	I	J	K
1	Symbol
2	ACC	22	1
3	ADANIENT	25	1	2	3
4	ADANIPORTS	15083	1	2	3	4	5
5	ADANIPOWER	17388	1
6	AMARAJABAT	100	1	2	34	5	6	7	8	9	10
7	ASIANPAINT	236	1	2
8

Worksheet: Sheet1

After running macro here: http://www.excelfox.com/forum/showth...ll=1#post13176

_____ Workbook: 2 1Mai.xlsm ( Using Excel 2007 32 bit )

_Row\^Col	A	B	C	D	E	F
1	Symbol
2	ACC	22	1	2
3	ADANIENT	25	1	2	3	4
4	ADANIPORTS	15083
5	ADANIPOWER	17388
6	AMARAJABAT	100
7	ASIANPAINT	236	1	2	3
8

Worksheet: Sheet1

Molly

**fixer** · 05-03-2020, 11:49 AM

Thnx Alot Mam for giving ur Precious Time and Great Support in solving this Problem
Problem Solved
Have a Great Day

**fixer** · 05-09-2020, 02:44 AM

Just out of interest, where do you come from?. What is your mother tongue?

Myself Avinash Reside in Mumbai from India & mother tongue Hindi

**Molly Brennholz** · 05-09-2020, 01:53 PM

Thanks for that info.
I am sorry to see that you have been banned.
But I can understand why. You really must at least try a little to read and understand, or at the very least read what we write once.
In your haste, you did not even see initially that I had written a full working macro for you here. Only by chance you noticed later!! I am sure you have ignored and / or missed much that has been done for you.
This is very impolite and disrespectful. You should at least have the decency to read all we write. Then after you can ask for more explanations, or more help.
But just continually asking and not even reading what we write is crazy

I hope all works out well for you. Alan is a lovely guy. For him to ban anyone is something I never thought I would ever live to see…

Take care and stay healthy
Molly
x

**fixer** · 05-17-2020, 04:01 PM

Molly Mam i completely agree with u & Doc Sir & i know its my mistake & Sorry for the same Mam

**fixer** · 05-21-2020, 08:15 PM

All files are located in different path
sheet name can be anything
I have a file ap.xls & Book1.xlsm
macro will be placed in Book1.xlsm
We have to look on Column S of ap.xls and If column S of ap.xls has negative numbers then we have to look on Column E of ap.xls & we will match that Column E data of ap.xls with column A of sheet1 of Book1.xlsm & if it matches then we will see wheather column C of Book1.xlsm has data in it or not & if column C of Book1.xlsm has data in it then do nothing & if column C of Book1.xlsm doesn't have data then we will go to sheet3 of Book1.xlsm and we will look for a match of Column E data of ap.xls with column A of sheet3 of Book1.xlsm & if it is found then we will copy the data from sheet3 of Book1.xlsm and paste it to sheet1 of book1.xlsm & we increase one more number in series in it

Sheet4 is the output that i need in Sheet1 (Result is pasted in sheet4 only for understanding purpose, i need result in sheet1 only)

plz see the sample file

**Molly Brennholz** · 05-22-2020, 03:17 AM

Hello Avinash.
Good to see you back!

I have written a macro for you here: https://excelfox.com/forum/showthrea...ll=1#post13417

I have written 'comments to explain the macro
We all understand that you do not want to learn any VBA. But it is madness to not attempt to understand anything of the coding which we give you.
I assume you will want to use these codings later for something important to you?
If this is the case, then you will fail, because we will not be with you later every step of the adventure.
You must make at least some attempt to understand the coding.

But its your choice.

Molly

Macro is also in Book1.xlsm
Share 'Book1.xlsm' : https://app.box.com/s/qotw65wmiq1aln7frg9o5gys8ke1l8xh
Share 'ap.xls' : https://app.box.com/s/r0tc0hkwoxrqjsqfu4gh7eqyy5jmqlg2

**fixer** · 05-22-2020, 02:07 PM

Thnx Alot Molly Mam For giving ur Great Support & helping me in solving this problem Mam

We all understand that you do not want to learn any VBA. But it is madness to not attempt to understand anything of the coding which we give you. (Thnx for understanding Me, But I Was Busy in making of Something & Now i am very near to get free time to do some work & then i will play with vba )

we will not be with you later every step of the adventure.(That Day will be the worst day of mine But i will some how manage it & i don't want that day should come)

Problem Solved