Compare two column in differents worksheets

Question

I created a macro that compare two columns in a different worksheet and highlight the matched cells with the green color

but the problem that both column got over than 9000 line so if I use this

for i =1 to lastrow 

it will take over than 5 min matching values and giving results

 Dim i As Variant, j As Integer, k As Integer


'lastRow = Sheets(1).Range("A1").End(xlDown).Row

'lastrow1 = Sheets(2).Range("A1").End(xlDown).Row
lastRow = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
lastRow1 = Sheets(2).Cells(Rows.Count, "A").End(xlUp).Row
     For i = 8 To 9252
If Sheets(1).Cells(i, 1).Value <> "" Then

   For j = 1 To 9252
        If Sheets(1).Cells(i, 4).Value = Sheets(2).Cells(j, 1).Value Then
            Sheets(1).Cells(i, 4).Interior.ColorIndex = 4

        End If
        Next j
 Else
    i = i + 1
    End If
    Next i

What I want is to find a solution to compare the two columns using Lastrow and find an efficient solution with no delays

Anyone got a clue about this ?

Best Regards Polos

Answer 1

You only want to find the value from Sheet1 on Sheet2; it doesn't matter if there are more than one matching value on Sheet2. Application.Match will locate identical values much faster than looping through all rows.

dim i as long, f as variant

with workSheets(1)
    for i=8 to .Cells(.Rows.Count, "A").End(xlUp).Row
        f = application.match(.cells(i, "A").value2, workSheets(2).columns("A"), 0)
        if not iserror(f) then
            .cells(i, "A").Interior.ColorIndex = 4
        end if
    next i
end with

With your original double-loop, even if the value from Sheet1 was found in the 10th row in Sheet2, you still kept comparing through the loop until row 9252. The cell in Sheet1 can only be colored once.

Answer 2

One approach is to use a dictionary as a set data structure to hold the values in sheet 2 and then use this dictionary in sheet 1. This will have the effect of changing your quadratic algorithm into a linear algorithm:

Sub ColorMatches()
    Dim i As Long
    Dim lastRow As Long
    Dim R As Range, cl As Range
    Dim D As Object
    Dim vals As Variant

    'load dictionary from sheet 2
    Set D = CreateObject("Scripting.Dictionary")
    lastRow = Sheets(2).Cells(Rows.Count, 1).End(xlUp).Row
    vals = Sheets(2).Range("A8:A" & lastRow).Value
    For i = LBound(vals) To UBound(vals)
        If Not D.exists(vals(i, 1)) Then D.Add vals(i, 1), 0
    Next i

    'use dictionary in sheet 1
    lastRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
    Set R = Sheets(1).Range("A1:A" & lastRow)
    For Each cl In R.Cells
        If D.exists(cl.Value) Then cl.Interior.ColorIndex = 4
    Next cl

End Sub

As a small but potentially important point: note that I used Long for i rather than Integer for row indices (as you did in your code). Modern versions of Excel have more rows than can be represented by an Integer variable, and 16 -bit ints are likely to be stored using 32 bits, so using Integer just risks overflow for no corresponding gain.

Answer 3

I believe this should do the trick. I'm not an expert, but learned the hard way a simple lesson: The less you interact with the sheets, the faster it works!

Option Explicit                                                             'Is worth using this option, so you remember declaring your variables

Sub SO()

Dim i As Long, j As Long, k As Long
Dim arrRange1 As Variant, arrRange2 As Variant, arrColor As Variant         'Declare arrays
ReDim arrColor(0)                                                           'Initial redim

Dim lastRow As Long                                                         'Only need to use one variable for this, and reassign as needed through the code
Dim sh1 As Worksheet: Set sh1 = ThisWorkbook.Sheets("RandomSheetName 1")    'Declare sheet 1
Dim sh2 As Worksheet: Set sh2 = ThisWorkbook.Sheets("RandomSheetName 2")    'Declare sheet 2

    With sh1
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row                    'Get last row from sheet 1 in column "A"
        arrRange1 = .Range(.Cells(8, 4), .Cells(lastRow, 4))                'Get all values from column "D", starting at row 8
    End With
    With sh2
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row                    'Get last row from sheet 2 in column "A"
        arrRange2 = .Range(.Cells(1, 1), .Cells(lastRow, 1))                'Get all values from column "A", starting at row 1
    End With

    For i = LBound(arrRange1) To UBound(arrRange1)                          'Loop through first sheet values
        If arrRange1(i, 1) <> "" Then                                       'If not empty, then...
            For j = LBound(arrRange2) To UBound(arrRange2)                  'Loop through second sheet values
                If arrRange1(i, 1) = arrRange2(j, 1) Then                   'If match, then...
                    ReDim Preserve arrColor(k)                              'Redim (preserve) the colours array
                    arrColor(k) = i + 7                                     'Add the value of i in the colours array (note +7, since yours sheet1 values start at row 8, feel free to amend)
                    k = k + 1                                               'Increase the counter for the colours array
                    Exit For                                                'As per idea from the accepted response, no point to check the whole sheet2 range if duplicate found already
                End If
            Next j
        End If
    Next i

    Application.ScreenUpdating = False                                      'It always helps to turn off the screenupdating when working with the sheets
    For i = LBound(arrColor) To UBound(arrColor)                            'Loop through the colours array
        If arrColor(0) = "" Then Exit For                                   'If the first element is empty, means no matches... exit here.
        sh1.Cells(arrColor(i), 4).Interior.ColorIndex = 4                   'Colour the cell as needed using the value we previously stored
    Next i
    Application.ScreenUpdating = True                                       'And lets not forget to turn it on again

End Sub

PS: please note that Rows.Count it will give you the count from the ActiveSheet , not from Sheet1 or Sheet2 . You need to make full reference, ie: Sheets(1).Rows.Count

So this:

lastRow = Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row

it should be

lastRow = Sheets(1).Cells(Sheets(1).Rows.Count, "A").End(xlUp).Row

or

With Sheets(1)
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With

Hope this helps!