Hello Again,

I have a VBA macros which is extracting difference after comparing 2 worksheets but I am struck on highlighting function.

I need to highlight the specific difference.

Example: In worksheet C2 value is Fruit and in worksheet 2 C2 is animal then it should extract that row from worksheets 2 in a new worksheet and highlight C2.

I hope I have explained my issue correctly.


Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet)
  Dim dupRow As Boolean
  Dim r As Long, c As Integer, m As Integer
  Dim lr1 As Long, lr2 As Long, lc1 As Integer, lc2 As Integer, lr3 As Long
  Dim maxR As Long, maxC As Integer, cf1 As String, cf2 As String
  Dim dupCount As Long
 
  Application.ScreenUpdating = False
  Application.StatusBar = "Creating the report..."
  Application.DisplayAlerts = True
  With ws1.UsedRange
    lr1 = .Rows.Count
    lc1 = .Columns.Count
  End With
  With ws2.UsedRange
    lr2 = .Rows.Count
    lc2 = .Columns.Count
  End With
  maxR = lr1
  maxC = lc1
  If maxR < lr2 Then maxR = lr2
  If maxC < lc2 Then maxC = lc2
  DiffCount = 0
  lr3 = 2
  For i = 2 To lr1
    dupRow = True
    Application.StatusBar = "Comparing worksheets " & Format(i / maxR, "0 %") & "..."
    For r = 2 To lr2
        For c = 2 To maxC
            ws1.Select
            cf1 = ""
            cf2 = ""
            On Error Resume Next
            cf1 = ws1.Cells(i, c).FormulaLocal
            cf2 = ws2.Cells(r, c).FormulaLocal
            On Error GoTo 0
            If cf1 <> cf2 Then
                dupRow = False
                Exit For
            Else
                dupRow = True
            End If
        Next c
        If dupRow Then
         Exit For
        End If
     Next r
       If Not dupRow Then
        dupCount = dupCount + 1
        ws1.Range(ws1.Cells(i, 1), ws1.Cells(i, maxC)).Select
        Selection.Copy
        Worksheets("Discrepancy Records").Select
        Worksheets("Discrepancy Records").Range(Worksheets("Discrepancy Records").Cells(lr3, 1), Worksheets("Discrepancy Records").Cells(lr3, maxC)).Select
        Selection.PasteSpecial
        lr3 = lr3 + 1
        ws1.Select
        For t = 1 To maxC
            ws1.Cells(i, t).Interior.ColorIndex = 19
            ws1.Cells(i, t).Select
            Selection.Font.Bold = True
        Next t
     End If
    Next i
Application.StatusBar = "Formatting the report..."
'Columns("A:IV").ColumnWidth = 10
m = dupCount
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox m & " Rows contain different values!", vbInformation, _
"Compare " & ws1.Name & " with " & ws2.Name
End Sub