copy and paste by VBA based on criteria

**fixer** · 04-22-2020, 06:37 PM

All files are located in different path
vba will be placed in a macro.xlsm
i have a file name 1.xls & 2.xls
match column I of 1.xls with column B of 2.xls
If column I of 1.xls matches with column B of 2.xls then do nothing &
if column I of 1.xls doesnt matches with column B of 2.xls then copy and paste the column B & Column I of 1.xls to column A & column B of sheet2 of 2.xls
sheet name can be anything
plz see the sample pic & help me in solving this problem by vba

the bigger pic is 1.xls
the smallest pic is sheet2 of 2.xls (result)

Moderator notice...
Yet again another cross post
https://www.excelguru.ca/forums/show...-condition-met

**DocAElstein** · 04-23-2020, 04:04 PM

I think you have not explained correctly what you want.
Your question explanation does not match you sample data.
Once again you have incorrectly explained what you want.

This is wrong!!!
If column I of 1.xls matches with column B of 2.xls then do nothing &
if column I of 1.xls doesnt matches with column B of 2.xls then copy and paste the column B & Column I of 1.xls to column A & column B of sheet2 of 2.xls
It is rubbish. It does not explain your test data.

Once again I must try to guess what you want!

This is my guess:
Consider the value in each row of column I of 1.xls, starting from row 2
If the value from that row of column I of 1.xls is also in any row of column B of the first worksheet in 2.xls , then
do nothing.
Else If the value from that row of column I of 1.xls is not to be found in any row of column B of the first worksheet in 2.xls, then do the following:
Copy the value from columns B and I for that row of 1.xls and paste them to columns A and B of the second worksheet of 2.xls

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

_Row\^Col	A	B
1	Exchange
2	NSE	25
3	NSE	10583
4	NSE	17388
5	NSE	100

Worksheet: Sheet1 (2)
_____ Workbook: 2.xls ( Using Excel 2007 32 bit )

_Row\^Col	A	B	C
1
2
3

Worksheet: Sheet2

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

_Row\^Col	A	B	C	D	E	F	G	H	I
1	Exchange	Symbol	Series/Expiry	Open	High	Low	Prev Close	LTP
2	NSE	ADANIENT	EQ	1087	1030	955.5	998.45	1079.9	25
3	NSE	ACC	EQ	148.05	27.75	25.65	25.65	146.5	22
4	NSE	DLF	EQ	265	419.7	350.05	387.25	267.15	10583
5	NSE	AMBUJACEM	EQ	30.4	155.8	142.55	145.85	29.95	17388
6	NSE	AMARAJABAT	EQ	502	514.85	502	499.05	507.45	100

Worksheet: 1-Sheet1

After results
_____ Workbook: 2.xls ( Using Excel 2007 32 bit )

_Row\^Col	A	B	C
1	ACC	22
2

Worksheet: Sheet2

Macro:

Code:

Sub Step11() '    http://www.excelfox.com/forum/showthread.php/2421-copy-and-paste-by-VBA-based-on-criteria?p=13110&viewfull=1#post13110      http://www.excelfox.com/forum/showthread.php/2458-Copy-and-paste-the-data-if-condition-met
Rem 1 Worksheets info
Dim Wb1 As Workbook, Wb2 As Workbook   '                           If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks,  Workbooks(" ")
 Set Wb1 = Workbooks("1.xls")         ' Workbooks("1.xlsx")         '          Workbooks("sample1.xlsx")   '                                                 Set Wb1 = Workbooks.Open(ThisWorkbook.Path & "\1.xls")                ' w1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")           ' change the file path   If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks,  Workbooks(" ")
 Set Wb2 = Workbooks("2.xls")         ' Workbooks("2.xlsx")         '          Workbooks("sample2.xlsx")   '                                                 Set Wb2 = Workbooks.Open(ThisWorkbook.Path & "\FundsCheck.xlsb")      ' w2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\FundsCheck.xlsb") ' change the file path      If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks,  Workbooks(" ")
Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws22 As Worksheet
 Set Ws1 = Wb1.Worksheets.Item(1)      '                                                                            Set Ws1 = Wb1.Worksheets("anything")  '     sheet name can be anything
 Set Ws2 = Wb2.Worksheets.Item(1)      '                                                                          ' Set Ws2 = Wb2.Worksheets("anything")
 Set Ws22 = Wb2.Worksheets.Item(2)
Dim Lr1 As Long, Lr2 As Long, Lr As Long, Lr22 As Long
 Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count).End(xlUp).Row      '   http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466      Making Lr dynamic ( using rng.End(XlUp) for a single column. )
 Let Lr2 = Ws2.Range("A" & Ws1.Rows.Count).End(xlUp).Row
' Let Lr = IIf(Lr2 > Lr1, Lr2, Lr1)
Rem 2 do it
Dim cnt
    For cnt = 2 To Lr2
    Dim VarMtch As Variant
     Let VarMtch = Application.Match(CStr(Ws1.Range("I" & cnt & "").Value), Ws2.Range("B2:B" & Lr2 & ""), 0) ' We look for the string value from each row in column I of Ws1 in the range of column B in Ws2
        If Not IsError(VarMtch) Then ' If we have a match, then  Application.Match  will return an integer of the position along(down) where the match is found
        ' do nothing
        Else '  Application.Match  will return a VB error string if no match could be found
         Ws1.Range("B" & cnt & ",I" & cnt & "").Copy  ' if ranges are "in line" - that is to say have the same "width" ( in this example a single row width ) , then VBA lets us copy this to the clipboard
         Let Lr22 = Lr22 + 1 ' next free row in second worksheet of 2.xls
         Ws22.Range("A" & Lr22 & "").PasteSpecial Paste:=xlPasteValues ' Pasting of copied values which were "in line" allows us to paste out, but the missing in between bits ( columns in this example ) are missed out - the ranges are put together. Co incidentally we want this output in this example
        End If
    Next cnt
End Sub