Compare multiple columns in 2 workbook's different worksheet, then copy and past values

[kp2016]

Hi,

I am facing problem in my code, need expert help.

Let me first explain problem statement and also share code as well.

Problem Statement:
I have 2 different workbook where I have data to be compared in multiple columns, if match is found then copy rows and paste it in active workbook.

When I run the VBA code, I will keep both the workbooks open, since I know which are the columns to be compared I have specifically mentioned the column name.

Here is my code:

Sub CompareColCopyRow()

    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim i As Long, j As Long
    Dim lastRow1 As Long, lastRow2 As Long
    Dim compareColumns1 As String, compareColumns2 As String
    Dim compareArray1 As Variant, compareArray2 As Variant
    Dim matchFound As Boolean
    
    Set wb1 = ActiveWorkbook 'the first workbook
    Set wb2 = Application.Workbooks("SOP Template.xlsx") 'the second workbook

    Set ws1 = wb1.Sheets("SPO_Mar") 'sheet name where data to be pasted
    Set ws2 = wb2.Sheets("CORTIX+Services+EMS") 'sheet name where data to be compared and copied
    
    lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row 'last row in the first sheet
    lastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row 'last row in the second sheet
    
    compareColumns1 = "D,E,F,K" 'columns to be compared in the first file
    compareColumns2 = "F,B,H,M" 'columns to be compared in the second file
    
    compareArray1 = Split(compareColumns1, ",")
    compareArray2 = Split(compareColumns2, ",")
    
    For i = 1 To lastRow2 'loop through each row in the second sheet
        matchFound = False 'assume the row doesn't match
        For j = 1 To lastRow1 'loop through each row in the first sheet
            If ws2.Cells(i, compareArray2(0)).Value = ws1.Cells(j, compareArray1(0)).Value And _
               ws2.Cells(i, compareArray2(1)).Value = ws1.Cells(j, compareArray1(1)).Value And _
               ws2.Cells(i, compareArray2(2)).Value = ws1.Cells(j, compareArray1(2)).Value And _
               ws2.Cells(i, compareArray2(3)).Value = ws1.Cells(j, compareArray1(3)).Value Then 'if all the values in the specified columns match
                matchFound = True 'mark the row as matching
                Dim copyRange As Range
                Set copyRange = ws2.Range("AJ" & i & ":AU" & i)
                copyRange.Copy 'copy the content including formula and format from second file's AN to HV column
                ws1.Range("AJ" & j).PasteSpecial xlPasteAllUsingSourceTheme 'paste the content and format to first file's AN to HV column upon match
                ' copy column width and formatting
                copyRange.Copy
                ws1.Range("AJ" & j & ":AU" & j).PasteSpecial xlPasteColumnWidths
                ws1.Range("AJ" & j & ":AU" & j).PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
                Exit For 'exit the loop if a match is found
                End If
        Next j
    Next i
    
    ' copy colums which contains formulas
    ws2.Range("AU:HV").Copy
    ws1.Range("AU:HV").PasteSpecial xlPasteAllUsingSourceTheme
    ws1.Range("AU:HV").PasteSpecial xlPasteColumnWidths
    ws1.Range("AU:HV").PasteSpecial xlPasteFormats
    
End Sub

 

[kp2016]

When I run this code, not all rows are compared and copied.

 

[sijpie]

The code seems pretty sound. It should go through all the rows. But maybe there are small differences like a trailing space that causes issues.
You could set a watch (bottom right window in the VBA editor) so the code pauses when it reaches a row where you think it should copy, but it doesn't.

If you have a great number of rows, then this code will take a considerable time to run.
It could be made a lot more efficient by working with arrays rather than reading all these cells one by one and writing a line for each match.