Copy Paste based on comparisons calculations in 2 XL files, 1 might be .csv file .Opened in XL=Fail/Chaos

**DocAElstein** · 04-28-2020, 01:47 AM

If the only change is to paste the data to Ws3, then I see just one error in your macro ,
Why have you changed to
For Cnt = 2 To Lr3 ?
It should still be
For Cnt = 2 To Lr2
The macro is going down rows in worksheet Ws2 from row 2 until the last row which is Lr2
My Lr22 = your Lr3 is the row count for data being pasted out : For each new data is needed a new row - the next row - the next row will be .. + 1

If the only change is to paste to Ws3 , then my original macro is only needed to be changed in 5 places

Code:

Sub Step11b() '   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, Wb3 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(" ")
 Set Wb3 = .......
Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 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)
 Set Ws3 = Wb3.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
         Ws3.Range("A" & Lr22 & "").PasteSpecial Paste:=xlPasteValues
        End If
    Next Cnt
End Sub

or if you prefer to use a different variable for the row count in Ws3 , Lr3 , then

Code:

Sub Step11b() '   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, Wb3 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(" ")
 Set Wb3 = .......
Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 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)
 Set Ws3 = Wb3.Worksheets.Item(2)
Dim Lr1 As Long, Lr2 As Long, Lr As Long, Lr3 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 Lr3 = Lr3+ 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
         Ws3.Range("A" & Lr3 & "").PasteSpecial Paste:=xlPasteValues
        End If
    Next Cnt
End Sub