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

**fixer** · 04-29-2020, 12:03 AM

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

macro will be placed in 2.xlsm
all files re located in different path
sheet name can be anything
plz see the sample file

**Molly Brennholz** · 04-29-2020, 04:37 PM

Hello Vixer.
This is similar to what I did for you before, I think.

Here I have some new explanations for you Here
http://www.excelfox.com/forum/showth...ll=1#post13165
http://www.excelfox.com/forum/showth...ll=1#post13164

Before:

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

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

Worksheet: Sheet1 (4)

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

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

Worksheet: Sheet1

now, run macro from here:
http://www.excelfox.com/forum/showth...ll=1#post13166

After results

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

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

Worksheet: Sheet1

Molly

**fixer** · 04-29-2020, 05:20 PM

Yes Molly Mam Actually it requires the modification to increase the output
Sorry for the same Mam But in future there will not be any question similar to this

**Molly Brennholz** · 04-29-2020, 06:48 PM

No need to apologise, I was just making a passing remark, that’s all
It was easy for me to do , because of the simularities to the previous Thread, that's all

.

**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 )