Macro to Highlight all matches between two sheets

[nigelse97]

I'm looking to implement a macro that would first match a name in column A of Sheet1 with a name in column A of Sheet2. It would then go through every column of that row in Sheet 2 and compare it against the row in Sheet1 and highlight all the matches in Yellow. This is what I have so far but it does not seem to be running properly.

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

Sub compareSheets(shtSheet1 As String, shtSheet2 As String)

Call LastCol
Dim i As Long
Dim j As Long
Dim c As Long


shtSheet1.Select
Range("A1").Select
Range(Selection, Selection.Select(xlDown)).Select
numb = Selection.Row.Count
shtSheet2.Select
Range("A1").Select
Range(Selection, Selection.Select(xlDown)).Select
numb2 = Selection.Row.Count

For i = numb To 1 Step -1
For j = numb2 To 1 Step -1
If ActiveWorkbook.Sheets(shtSheet1).Range("A" & i) = ActiveWorkbook.Sheets(shtSheet2).Range("A" & j) Then
For c = 1 To ColRow
If ActiveWorkbook.Sheets(shtSheet1).Cell(i, c) = ActiveWorkbook.Sheets(shtSheet2).Cell(j, c) Then
ActiveWorkbook.Sheets(shtSheet2).Cell(j, c).Interior.Color = vbYellow
End If
Next
End If
Next
Next

End Sub

Sub LastCol()

Dim LastCol As Integer

ColRow = ActiveSheet.UsedRange.Col.Count

End Sub

 

[jmacleary]

Hi there. I have had a quick go at this and I think this code will do it for you.

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

Sub compareSheets(shtSheet1 As String, shtSheet2 As String)

    Dim i As Long
    Dim j As Long
    Dim c As Long
    Dim numb2 As Long
    Dim numb As Long
    Dim ColRow As Long

    numb = Sheets(shtSheet1).Cells(Rows.Count, 1).End(xlUp).Row
    numb2 = Sheets(shtSheet2).Cells(Rows.Count, 1).End(xlUp).Row

    ColRow = Sheets(shtSheet2).UsedRange.Columns.Count

    ' remove the next 3 lines if you don't want to clear the backgrounds
    With Sheets(shtSheet2)
    .Range(.Cells(1, 1), .Cells(numb2, ColRow)).Interior.Pattern = xlNone
    End With

    For i = numb To 1 Step -1
        For j = numb2 To 1 Step -1
            If ActiveWorkbook.Sheets(shtSheet1).Range("A" & i) <> "" And ActiveWorkbook.Sheets(shtSheet1).Range("A" & i) = ActiveWorkbook.Sheets(shtSheet2).Range("A" & j) Then
                For c = 1 To ColRow
                    If ActiveWorkbook.Sheets(shtSheet1).Cells(i, c) = ActiveWorkbook.Sheets(shtSheet2).Cells(j, c) Then
                        ActiveWorkbook.Sheets(shtSheet2).Cells(j, c).Interior.Color = vbYellow
                    End If
                Next
            End If
        Next
    Next

End Sub