How do you compare values of 2 cells with values of 2 other cells using array method?

Question

I have two columns (A & B) of company names & cities. I have another two columns (D & E) of the same. If a certain row of A&B is not present in any row of D&E then I need to add that row of A&B to the end of columns D&E. So basically match and if no match then add. About 550 rows of data in A&B and 6000 in D&E. For loop takes 73 and StrComp 357 secs. This is just one file and I have a few thousand of these files. The StrComp is based on - In Excel 2010 compare data from columns and highlight values if different using macro and VBA. I tried the array method by mehow at Fast compare method of 2 columns - its very fast - currently compares column A with column D and appends at the end of column D in 1 sec. Been struggling to modify it to do a 2-column (A&B) to 2-column (D&E) matching for quite some time...am I missing something fairly simple or is this too complex? Thanks much for any help... Code I am trying to modify -

Sub CompareAddArr()
    Application.ScreenUpdating = False

    Dim stNow As Date
    stNow = Now

    Dim arr As Variant
    arr = Range("A2:A" & Range("A" & Rows.Count).End(xlUp).Row).Value
    Dim varr As Variant
    Set varr = Range("D2:D" & Range("D" & Rows.Count).End(xlUp).Row).Value
    Dim x, y, match As Boolean
    For Each x In arr
    match = False
    For Each y In varr
    If x = y Then match = True  'this matches colA with colD - 1col-1col
    'here need something like - if x = y and a = b Then match = True (for ColB with ColE) 
    Next y
    If Not match Then
    Range("D" & Range("D" & Rows.Count).End(xlUp).Row + 1) = x
    'here need something like - Range("E" & Range("E" & Rows.Count).End(xlUp).Row + 1) = a
    End If
    Next

    Application.ScreenUpdating = True
    MsgBox DateDiff("s", stNow, Now)
End Sub

Answer 1

To adapt this code, you should:

1. Use a Worksheet variable. That way your code isn't bound to the ActiveSheet
2. Get both columns of each range into your Variant Arrays
3. Loop over the arrays, comparing both items in each row
4. Exit the inner loop early when a match is found
5. Accumulate data to copy into another Variant array (this avoid accessing the sheet for each result)

6. Copy the resulting new data in one go at the end of the loops

   Sub CompareAddArr()
       Dim arr As Variant
       Dim varr As Variant
       Dim x, y, match As Boolean
       Dim i As Long, j As Long
       Dim InsertRow As Long
       Dim Newdata As Variant
       Dim ws As Worksheet
   
       Set ws = ActiveSheet
   
       With ws
           arr = Range(.Cells(2, 2), .Cells(.Rows.Count, 1).End(xlUp)).Value
           varr = Range(.Cells(2, 5), .Cells(.Rows.Count, 4).End(xlUp)).Value
           InsertRow = 1
           ReDim Newdata(1 To 2, 1 To UBound(arr, 1))
   
           For i = 1 To UBound(arr, 1)
               match = False
               For j = 1 To UBound(varr, 1)
                   If arr(i, 1) = varr(j, 1) And arr(i, 2) = varr(j, 2) Then
                       match = True
                       Exit For
                   End If
               Next
               If Not match Then
                   Newdata(1, InsertRow) = arr(i, 1)
                   Newdata(2, InsertRow) = arr(i, 2)
                   InsertRow = InsertRow + 1
                   'Like LR = LR + 1, how can I increment UBound(varr, 1) by 1 here
               End If
           Next
           If InsertRow > 1 Then
               ReDim Preserve Newdata(1 To 2, 1 To InsertRow - 1)
               .Range("D2:E2").Offset(UBound(varr, 1)).Resize(UBound(Newdata, 2), 2).Value = _
                 Application.Transpose(Newdata)
           End If
       End With
   End Sub
   

---

Update - New requirement, add unique entries only once

To add a record from arr only if it's not already added, test the Newdata array and only if it's not already in that array, add it.

I've also added a parameter to specify how many columns to process and the corresponding code

Sub CompareAddArrUnique()
    Dim arr As Variant
    Dim varr As Variant
    Dim match As Boolean
    Dim i As Long, j As Long
    Dim InsertRow As Long
    Dim Newdata As Variant
    Dim ws As Worksheet
    Dim NumberOfColumns As Long
    Dim col As Long

    Set ws = ActiveSheet

    NumberOfColumns = 2
    With ws
        arr = Range(.Cells(2, NumberOfColumns), .Cells(.Rows.Count, 1).End(xlUp)).Value
        varr = Range(.Cells(2, 4 + NumberOfColumns - 1), .Cells(.Rows.Count, 4).End(xlUp)).Value
        InsertRow = 1
        ReDim Newdata(1 To NumberOfColumns, 1 To UBound(arr, 1))

        For i = 1 To UBound(arr, 1)
            match = False
            For j = 1 To UBound(varr, 1) ' <---
                match = True
                For col = 1 To NumberOfColumns ' <---
                    match = match And (arr(i, col) = varr(j, col))
                    If Not match Then Exit For
                Next
                If match Then Exit For
            Next
            If Not match Then
                For j = 1 To InsertRow - 1
                    match = True
                    For col = 1 To NumberOfColumns
                        match = match And (arr(i, col) = Newdata(col, j))
                        If Not match Then Exit For
                    Next
                    If match Then Exit For
                Next
            End If
            If Not match Then
                For j = 1 To NumberOfColumns
                    Newdata(j, InsertRow) = arr(i, j)
                Next
                InsertRow = InsertRow + 1
            End If
        Next
        If InsertRow > 1 Then
            ReDim Preserve Newdata(1 To 2, 1 To InsertRow - 1)
            .Range("D2:E2").Offset(UBound(varr, 1)).Resize(UBound(Newdata, 2), 2).Value = _
              Application.Transpose(Newdata)
        End If
    End With
End Sub