How to Comparing Two Workbooks with Multiple Sheets and Highlighting Duplicates

How to compare two workbooks with multiple sheets and highlighting duplicates

Requirement:

The user is comparing sheets in two different workbooks. A currently opened new workbook, and an unopened dummy workbook. With the following code, the user is able to highlight only if the everything is exactly the same, so it seems like I'm at least identifying workbooks and worksheets correctly. What the user trying to do, is compare the cells in column E in the dummy workbook against the cells in column E in the new workbook, and highlight the entire row of a match in the new workbook, even if the duplicates are in different rows between books.

Code:

 Sub NoSearch6()

Dim Bk1 As Workbook
Dim Bk2 As Workbook
Dim Sh1 As Worksheet
Dim Sh2 As Worksheet
Dim jRow As Long
Dim LastRow As Long

Set Bk1 = ThisWorkbook
Set Sh1 = Bk1.Sheets("Fake Name")
Workbooks.Open Filename:="C:\Dummy File\DummyFile.xlsx"
Set Bk2 = ActiveWorkbook
Set Sh2 = Bk2.Sheets("Fake Name")

LastRow = 100

For jRow = LastRow To 2 Step -1
  If Sh1.Cells(jRow, "E") <> "" Then
        If Sh1.Cells(jRow, 5) = Sh2.Cells(jRow, 5) Then
                Sh1.Rows(jRow).Style = "40% - Accent2"
        End If
    End If
Next


Bk2.Close

End Sub

Solution:

Code:

Sub NoSearch6()
    Application.ScreenUpdating = False
    Dim Bk1 As Workbook, Bk2 As Workbook, Sh1 As Worksheet, Sh2 As Worksheet, rng As Range, LastRow As Long, sAddr As String, fnd As Range
    Set Bk1 = ThisWorkbook
    Set Sh1 = Bk1.Sheets("Fake Name")
    Workbooks.Open Filename:="C:\Dummy File\DummyFile.xlsx"
    Set Bk2 = ActiveWorkbook
    Set Sh2 = Bk2.Sheets("Fake Name")
    LastRow = Sh2.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each rng In Sh2.Range("E2:E" & LastRow)
        Set fnd = Sh1.Range("E:E").Find(rng, LookIn:=xlValues, lookat:=xlWhole)
        If Not fnd Is Nothing Then
            sAddr = fnd.Address
            Do
                fnd.EntireRow.Style = "40% - Accent2"
                Set fnd = Sh1.Range("E:E").FindNext(fnd)
            Loop While fnd.Address <> sAddr
            sAddr = ""
        End If
    Next rng
    Bk2.Close False
    Application.ScreenUpdating = True
End Sub

Obtained from the OzGrid Help Forum.

Solution provided by Mumps.