Excel VBA - Find matching values in columns and return value in another column

Question

I would like to determine if the values in Column H of Workbook 1 and Column A of Workbook 2 match, then return “Y” in the corresponding rows of Column S of Workbook 1 for matches, “N” for non-matches.

However, the duration required to run my current code is extremely long (> 15 minutes), is there a way to shorten it?

Here is my current VBA code:

Dim j, LastRow As Long
Dim answer, found As Range

LastRow = Workbooks("1.xlsx").Sheets("AA").Range("H" & Rows.Count).End(xlUp).Row

For j = 1 To LastRow
answer = Workbooks("1.xlsx").Sheets("AA").Range("H" & j).Value

Set found = Workbooks("2.xlsx").Sheets("BB").Columns("A:A").Find(what:=answer)

If found Is Nothing Then
    Workbooks("1.xlsx").Sheets("AA").Range("S" & j).Value = "N"
Else
    Workbooks("1.xlsx").Sheets("AA").Range("S" & j).Value = "Y"
End If

Next j

What is the value of LastRow ? Are the workbooks on a network drive ? — CDP1802, Aug 10 '21 at 10:12
How many rows do you have? That's an excessively long time for what you're doing. Best way is to load your two ranges into arrays and compare them. Otherwise you can turn off the 3 key players that slow down worksheet code (ScreenUpdating,Calculations,Events). See an example [here](https://stackoverflow.com/a/47092175/2632165) for that. — Simon, Aug 10 '21 at 10:14
There are 32,840 rows on the first workbook's column A in total. — TropicalMagic, Aug 10 '21 at 23:46

score 1 · Answer 1 · answered Aug 10 '21 at 10:58

Again as per my comment you can try disabling the 3 key players that slow down workbook/sheet codes:

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False

'''Your code here'''
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

I did however, try an array version for you which you can find below. See if that works for you.

Sub CompareWorkbooks()

Dim LRow1 As Long, LRow2 As Long, Arr1 As Variant, Arr2 As Variant
Dim i As Long, j As Long

LRow1 = Workbooks("1.xlsx").Sheets("AA").Range("H" & Rows.Count).End(xlUp).Row
LRow2 = Workbooks("2.xlsx").Sheets("BB").Range("A" & Rows.Count).End(xlUp).Row
Arr1 = Application.Transpose(Workbooks("1.xlsx").Sheets("AA").Range("H1:H" & LRow1).Value)
Arr2 = Application.Transpose(Workbooks("2.xlsx").Sheets("BB").Range("A1:A" & LRow2).Value)

For i = 1 To LRow1
    For j = 1 To LRow2
        If Arr1(i) = Arr2(j) Then
            Arr1(i) = "Y"
            Exit For
        End If
        If j = LRow2 Then
            Arr1(i) = "N"
        End If
    Next j
Next i

Workbooks("1.xlsx").Sheets("AA").Range("S1:S" & LRow1).Value = Application.Transpose(Arr1)

End Sub

It essentially loads the two ranges into arrays. Then compares the arrays and as it goes, replaces array 1 values with either Y or N if a match was found or not. Then once the loop is complete it dumps the changed array into your column S all at once. So the worksheet isn't touched during the loop as it's all done in memory which is a lot faster. My computer did 2000 rows of numbers in about a second.

Thank you very much! It worked! I also followed your suggestions to disable the 3 key players. It also took about 12 seconds to compare Workbook 1's Column H of 32,840 rows with that of Workbook 2's Column A of 200 rows! — TropicalMagic, Aug 10 '21 at 15:54

FaneDuru · Accepted Answer · 2021-08-10T11:04:51.403

Please, try the next code:

Sub matchData()
  Dim ws As Worksheet, ws2 As Worksheet, j, LastRow As Long, arrH, arrFin
  Dim answer, found As Range
  
  Set ws = Workbooks("1.xlsx").Sheets("AA")
  Set ws2 = Workbooks("2.xlsx").Sheets("BB")
  LastRow = ws.Range("H" & rows.count).End(xlUp).row
  
  arrH = ws.Range("H1:H" & LastRow).value 'put the range in an array to make the iteration faster
  ReDim arrFin(1 To UBound(arrH), 1 To 1) 'redim the array to receive the comparison result
  For j = 1 To UBound(arrH)
        answer = ws.Range("H" & j).value
        
        Set found = ws2.Columns("A:A").Find(what:=answer) 'faster than iteration even in an array...
        
        If found Is Nothing Then
            arrFin(j, 1) = "N"  'fill the array element with the appropriate string
        Else
            arrFin(j, 1) = "Y"  'fill the array element with the appropriate string
        End If
  Next j
  ws.Range("S1").Resize(UBound(arrFin), 1).value = arrFin 'drop the array content at once (very fast)
End Sub

I would like to receive some feedback about its duration...

Thank you very much! It worked! It took about 12 seconds to compare Workbook 1's Column H of 32,840 rows with that of Workbook 2's Column A of 200 rows! — TropicalMagic, Aug 10 '21 at 15:54
@TropicalMagic Glad I could help! Butt we here, when somebody answer our question, tick the code left side check box, in order to make it **accepted answer**. If somebody else search for a similar issue, he will know that the marked one works and it was preferred. I am not talking about my answer! Please, mark the one you prefer. — FaneDuru, Aug 10 '21 at 17:35

Excel VBA - Find matching values in columns and return value in another column

2 Answers2