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?
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
来源：https://stackoverflow.com/questions/15007293/compare-two-sheets-using-arrays