Compare two sheets and highlight unmatched rows or copy to new sheet

[Fatman003]

I want to match rows from two different sheets and put the unmatched rows into another Sheet3 or it should just highlight in the first column of the unmatched row (depending on the easier method). The code should compare the rows of the two Sheets and copy the outstanding rows into a newly created sheet. Sheet2 (say Jan 2020) contains more rows than Sheet1 (Dec 2019) as its the recently updated sheets and they both contain rows of over 22 thousand with both having unique ID as the first column.

My below code tries to highlight all the unmatching cells and takes longer time to finish. So one of the fastest way is for it to just highlight the first column of the rows or copy the row into a new sheet.

Sub RunCompare()
Call compareSheets("Sheet1", "Sheet2")
End Sub

Sub compareSheets(shtSheet1 As String, shtSheet2 As String)
Dim c As Integer, j As Integer, i As Integer, mydiffs As Integer, cnt1 As Integer, cnt2 As Integer
Dim noexist As Integer
cnt2 = Worksheets("Sheet2").Cells.SpecialCells(xlCellTypeLastCell).Row
cnt1 = Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeLastCell).Row
'For each cell in sheet2 that is not the same in Sheet1, color it yellow
For i = 1 To cnt2
    For j = 1 To cnt1
        If ActiveWorkbook.Worksheets(shtSheet2).Cells(i, 1).Value = ActiveWorkbook.Worksheets(shtSheet1).Cells(j, 1).Value Then
            For c = 2 To 22
                If Not ActiveWorkbook.Worksheets(shtSheet2).Cells(i, c).Value = ActiveWorkbook.Worksheets(shtSheet1).Cells(j, c).Value Then
                    ActiveWorkbook.Worksheets(shtSheet2).Cells(i, c).Interior.Color = vbYellow
                    mydiffs = mydiffs + 1
                End If
            Next
        Exit For
        End If
        If j = cnt1 Then
            ActiveWorkbook.Worksheets(shtSheet2).Cells(i, 1).Interior.Color = vbRed
        End If
    Next
Next
'Display a message box to demonstrate the differences and if there is a new entry on the second sheet
'MsgBox mydiffs & ":differences found, " & noexist & ":no exist", vbInformation
ActiveWorkbook.Sheets(shtSheet2).Select
End Sub

 

[Fatman003]

Still havent gotten any solution that works to this problem. Can anyone please help out?

 

[Fluff]

How about

Sub Fatman()
   Dim Ary1 As Variant, Ary2 As Variant
   Dim r As Long, c As Long, rr As Long
   
   Ary1 = Sheets("Sheet1").UsedRange.Value2
   Ary2 = Sheets("Sheet2").UsedRange.Value2
   For r = 1 To UBound(Ary2)
      For rr = 1 To UBound(Ary1)
         If Ary1(rr, 1) = Ary2(r, 1) Then
            For c = 2 To 22
               If Ary1(rr, c) <> Ary2(r, c) Then Sheets("Sheet2").Cells(r, c).Interior.Color = vbYellow
            Next c
         End If
      Next rr
   Next r
End Sub

 

[Fatman003]

Thanks @Fluff, but it doesnt do what I expected. your code highlights different random cells. What I want is for the code to compare the values of column A only and color the cell that is not matched in Sheet 2.

 

[Fluff]

That is not what your code is doing, it's comparing every cell in columns 2 to 22.
Is that not what you want?

 

[Fatman003]

No, Sorry. I want just the first column comparison

 

[Fluff]

So if col A in sheet 2 is not in Sheet1 highlight it?

 

[Fatman003]

Yes, Exactly.

 

[Fluff]

How about

Sub Fatman()
   Dim Ary1 As Variant, Ary2 As Variant
   Dim r As Long
   
   Ary1 = Sheets("Sheet1").UsedRange.Value2
   Ary2 = Sheets("Sheet2").UsedRange.Value2
   With CreateObject("scripting.dictionary")
      For r = 1 To UBound(Ary1)
         .Item(Ary1(r, 1)) = Empty
      Next r
      For r = 1 To UBound(Ary2)
         If Not .Exists(Ary2(r, 1)) Then Sheets("Sheet1").Cells(r, 1).Interior.Color = vbYellow
      Next r
   End With
End Sub

 

[Fatman003]

It works. Just change the Sheet1 to Sheet2 on line 12 and viola. thanks a lot @Fluff