Compare two sheets and highlight unmatched rows using unique ID only

Question

I want to match rows from two different sheets and highlight only in the first column of the unmatched row or better still copy the unmatched rows into a new sheet. The code should compare the rows of the two Sheets and color the new rows in the second sheet. Sheet2 (say Jan 2020) contains more rows than Sheet1 (Dec 2019) as its the recently updated sheet and they both contain rows of over 22k 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. What I wish is for the code to just color the unmatched in column A (the vb.Red) only(since its the unique ID) while ignoring the rest of the column/cells (vb.Yellow) and or if possible copy the highlighted rows into a new sheet.

Sub RunCompare()
Call compareSheets("Sheet1", "Sheet2") 'compareSheets("2019-01 Database", "2019-02 Database")
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

• Foxfire And Burns And Burns: You could use COUNTIF just to check if the ID exists or not. If the count returns 0, means not, otherways means yes. VBA version is Application.WorksheetFunction.Countif

Answer 1

Let's simplify the task and do it step by step.

• This is how the input in the two sheets can look like:

enter image description here

enter image description here

Then, we may consider reading these and saving them to an array:

---

Set rangeA = ThisWorkbook.Worksheets(1).Range("A1:Z1")
Set rangeB = ThisWorkbook.Worksheets(2).Range("A1:ZZ1")
Dim arrayA As Variant
Dim arrayB As Variant
With Application
 arrayA = .Transpose(.Transpose(rangeA))
 arrayB = .Transpose(.Transpose(rangeB))
End With

• Looping between the data in the two arrays is quite fast in vba. The writing to the third worksheet is done only once the two values from the two arrays match:

---

Dim myValA As Variant
Dim myValB As Variant
Dim currentRow As Long: currentRow = 1
For Each myValA In arrayA
 For Each myValB In arrayB
 If myValA = myValB Then
 ThisWorkbook.Worksheets(3).Cells(currentRow, 1) = myValA
 currentRow = currentRow + 1
 End If
 Next
Next

This is the result in the third worksheet, all matching values are in a single row:

enter image description here

This is how the whole code looks like:

Sub CompareTwoRanges()
 Dim rangeA As Range
 Dim rangeB As Range
 Set rangeA = ThisWorkbook.Worksheets(1).Range("A1:Z1")
 Set rangeB = ThisWorkbook.Worksheets(2).Range("A1:ZZ1")
 Dim arrayA As Variant
 Dim arrayB As Variant
 With Application
 arrayA = .Transpose(.Transpose(rangeA))
 arrayB = .Transpose(.Transpose(rangeB))
 End With
 Dim myValA As Variant
 Dim myValB As Variant
 Dim currentRow As Long: currentRow = 1
 For Each myValA In arrayA
 For Each myValB In arrayB
 If myValA = myValB Then
 ThisWorkbook.Worksheets(3).Cells(currentRow, 1) = myValA
 currentRow = currentRow + 1
 End If
 Next
 Next
End Sub

Note - there will be another performance bonus, if the results are written to an array and then written from the array to the worksheet. Thus the writing would happen only once. This is the change, that needs to be implemented in the code, after the array declarations:

Dim myValA As Variant
Dim myValB As Variant
Dim resultArray() As Variant
ReDim Preserve resultArray(2 ^ 20)
Dim i As Long: i = 0
For Each myValA In arrayA
 For Each myValB In arrayB
 If myValA = myValB Then
 resultArray(i) = myValA
 i = i + 1
 End If
 Next
Next
ReDim Preserve resultArray(i)
ThisWorkbook.Worksheets(3).Cells(1, 1).Resize(UBound(resultArray)) = Application.Transpose(resultArray)

• Fathi: Thanks @Vityata, seems you got it wrong. With your graphical representation,considering rows 2 of the first sheet contains all elements in your row1 Sheet2. Sheet 3 would then be row 1 of Sheet1 as this is the unmatched row from the two sheets. I dont want to consider all the cells in the sheets but only the first cell (Column A) as it wouldnt take time to complete
• Vityata: @Abdlfatah - I am resolving a more general question - comparing two ranges for equal values. In the code, every range is presented in a single row, on a different worksheets. How these ranges are exactly presented, whether they are in columns, rows or etc, is dependent on the structure of the problem.

Answer 2

when you get cell value, it spends time.

so, you can target Range transfer 2d Variant

Dim endRow AS Long
Dim olderRange AS Range
Dim olderVariant AS Variant
endRow = olderSheet.cells(rows.count,1).end(xlup).row
Set olderRange = olderSheet.Range(olderSheet.Cells(startRow, startCol), olderSheet.Cells(endRow, endCol))
'Transfer
olderVariant = olderRange 
For currentRow = 1 to UBound(olderVariant, 1)
 'Loop
 'if you want change real Cell value Or interior
 'add row Or Col weight
 if olderVariant(currentRow, currentCol) = newerVariant(currentRow, currentCol) THen
 newerSheet.Cells(currentRow+10,currentCol+10).interior.colorIndex = 3
 End if
Next currentRow

• Fathi: I subscribe to the idea of using Range but I couldnt get you code to work.. newerVariant isnt defined. Sorry, my Vb skills is still basic @sacru2red
• Sacru2red: @Abdlfatah the code in my comment is not perpect And i didnt understand your question. my code is just hint snipet, its not work
• Fathi: my question is two compare rows of two sheets and highlight only the first row of the second sheet. For example; if sheet 1 has xx, xx1 in the first & 2nd row respectively and sheet2 has xx, xx1, xx2 in its rows, then xx2 should be highlighted in the sheet2 since it doesnt appear in sheet1
• Sacru2red: actually, its not enough information. they are same row number? they are same field name? can you show me table?

Answer 3

In case anyone has the same kind of problem, I have found an easier way to do it. Providing your sheet2 is the comparison sheet:

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("Sheet2").Cells(r, 1).Interior.Color = vbRed
 Next r
End With