Compare two sheets using arrays

Question

My code is super slow (10+ min for each sheet) due to the quantity of data i have. I believe there may be a way to speed it up using arrays, but i am not sure how to go about it. I will try to explain the situation in detail.

I have two worksheets with invoice#s, part#s and sale prices (among other info) that I am trying to compare to find differences. I've created a unique number for each line of data using a concatenation of the invoice# and the part# on both sheets. I've also sorted both sheets manually by that number. I'd like to find which of those unique#s are on sheet1 and not on sheet2 and vice versa. (Another part of this would be to check the ones that Do match and see if the sales price is different, but I think I could figure that out easily enough.) The goal is to see what invoices were missed either partially or completely by vendor and my company.

I have about 10k rows of data in one sheet and 11k in the other. Below is the code i am currenlty using modified from what i found at www.vb-helper.com/howto_excel_compare_lists.html and from looking at answers to similar questions on this site. There is a nearly identical second sub with the sheets reversed. I don't know if it is possible to write just one that does it both ways.

Private Sub cmdCompare2to1_Click()
Dim first_index As Integer
Dim last_index As Integer
Dim sheet1 As Worksheet
Dim sheet2 As Worksheet
Dim r1 As Integer
Dim r2 As Integer
Dim found As Boolean

Set sheet1 = Worksheets(1)
Set sheet2 = Worksheets(2)

Application.ScreenUpdating = False

first_index = 1
last_index = sheet1.Range("a" & Rows.Count).End(xlUp).Row

' For each entry in the second worksheet, see if it's
' in the first.
For r2 = first_index To last_index
    found = False
    ' See if the r1-th entry on sheet 2 is in the sheet
    ' 1 list.
    For r1 = first_index To last_index
        If sheet1.Cells(r1, 16) = sheet2.Cells(r2, 9) Then
        ' We found a match.
            found = True
            Exit For
        End If
    Next r1

    ' See if we found it.
    If Not found Then
        ' Flag this cell.
        sheet2.Cells(r2, 9).Interior.ColorIndex = 35
        End If
Next r2

Application.ScreenUpdating = True

End Sub

It works fine for small sets of data, but with the large number of rows i am making it go through, it just takes forever and none of the Accountants want to use it. Ideally, instead of just turning the differences green, it would copy them to a seperate sheet, ie: sheet 3 would have everything on sheet 2 not on sheet 1, but i'll take what i can get at this point.

After looking around for a solution, it seems everyone on the internet agrees that the use of arrays is needed to speed it up. However, i can't figure out how to apply that lovely bit of advice to my current code. I realize that there is a good possibility that will have to scrap this code and start over, but again i ask how?

Answer 1

Welcome to SO. Great question. Give this procedure a shot. You could probably tidy it up a bit, but it should work and be significantly faster.

For reference, see this link.

Update: I tested this on two randomly generated data sets of 10K and 11K rows. It took less than a blink of an eye. I didn't even have time to look at see the time when I started.

Option Explicit

Private Sub cmdCompare2to1_Click()

Dim sheet1 As Worksheet, sheet2 As Worksheet, sheet3 As Worksheet
Dim lngLastR As Long, lngCnt As Long
Dim var1 As Variant, var2 As Variant, x
Dim rng1 As Range, rng2 As Range


Set sheet1 = Worksheets(1)
Set sheet2 = Worksheets(2)
Set sheet3 = Worksheets(3) ' assumes sheet3 is a blank sheet in your workbook

Application.ScreenUpdating = False

'let's get everything all set up
'sheet3 column headers
sheet3.Range("A1:B1").Value = Array("in1Not2", "in2Not1")

'sheet1 range and fill array
With sheet1

    lngLastR = .Range("A" & .Rows.Count).End(xlUp).Row

    Set rng1 = .Range("A1:A" & lngLastR)
    var1 = rng1

End With

'sheet2 range and fill array
With sheet2

    lngLastR = .Range("A" & .Rows.Count).End(xlUp).Row

    Set rng2 = .Range("A1:A" & lngLastR)
    var2 = rng2

End With

'first check sheet1 against sheet2
On Error GoTo NoMatch1
For lngCnt = 1 To UBound(var1)

    x = Application.WorksheetFunction.Match(var1(lngCnt, 1), rng2, False)

Next


'now check sheet2 against sheet1
On Error GoTo NoMatch2
For lngCnt = 1 To UBound(var2)

    x = Application.WorksheetFunction.Match(var2(lngCnt, 1), rng1, False)

Next

On Error GoTo 0
Application.ScreenUpdating = True
Exit Sub

NoMatch1:
    sheet3.Range("A" & sheet3.Rows.Count).End(xlUp).Offset(1) = var1(lngCnt, 1)
    Resume Next


NoMatch2:
    sheet3.Range("B" & sheet3.Rows.Count).End(xlUp).Offset(1) = var2(lngCnt, 1)
    Resume Next


End Sub