Geek asks and answers

Compare two sheets using arrays

My code is very slow (10 + min for each sheet) due to the amount of data that I have. I believe that there may be a way to speed up its use of arrays, but I'm not sure how to do this. I will try to explain the situation in detail.

I have two worksheets with invoices # s, part # s and selling prices (among other information), which I am trying to compare to find the differences. I created a unique number for each row of data using the concatenation of invoice # and part # on both sheets. I also sorted both sheets manually by this number. I would like to find which of these unique # s are on sheet1 and not on sheet2 and vice versa. (Another part of this is to check those that match each other and see if the selling price is different, but I think I could figure it out quite easily.) The goal is to see which invoices were skipped. either partially or fully by the supplier and my company.

I have about 10 thousand rows of data in one sheet and 11k in another. Below is the code I am currenlty, which was changed from what I found at www.vb-helper.com/howto_excel_compare_lists.html, and looked at answers to similar questions on this site. There is an almost identical second submaterial with inverted sheets. I do not know if it is possible to write only one that does this in both directions.

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 great for small data sets, but with a lot of lines that I go through, it just takes forever, and not one of the accountants wants to use it. Ideally, instead of just turning the differences into green, they copied them onto a separate sheet, i.e. Sheet 3 would have everything on sheet 2, not sheet 1, but I will take what I can get at that moment.

, , , . , . , , , , ?

+5
1

SO. . . , , .

. .

: 10K 11K . . , .

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 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
+6

More articles:


All Articles