Compare two worksheets

Life is 10% what happens to us and 90% how we react to it. If you don't build your dream, someone else will hire you to help them build theirs.

Compare two worksheets

In this article you will learn, how to compare two excel worksheet data. First we will create a macro and run it. This macro will check the both worksheets cell by cell and highlight the matching data.

''main macro sub-routine. 
''This will call the CompareWorksheet sub-routine
Sub CompareData()
  ''Here "Sheet1" and "Sheet2" are the name of 
  ''both the worksheets.
  ''Please note that both the sheets should be in same file.
  CompareWorksheets Worksheets("Sheet1"), Worksheets("Sheet2")
End Sub
 
Sub CompareWorksheets(ws1 As Worksheet, ws2 As Worksheet)
  Dim diffB 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
  Dim maxR As Long, maxC As Integer, cf1 As String
  Dim cf2 As String
  Dim rptWB As Workbook, DiffCount As Long
  Application.ScreenUpdating = False
  Application.StatusBar = "Creating..."
  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
  For c = 1 To maxC
    For i = 2 To lr1
      diffB = True
      Application.StatusBar = "Comparing Cell" _
	   & Format(i / maxR, "0 %") 
        For r = 2 To lr2
          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
            diffB = False
            ws1.Cells(i, c).Interior.ColorIndex = 19
            ws1.Cells(i, c).Select
            Selection.Font.Bold = True
            Exit For
          End If
        Next r
 
     If diffB Then
       DiffCount = DiffCount + 1
       ws1.Cells(i, c).Interior.ColorIndex = 0
       ws1.Cells(i, c).Select
       Selection.Font.Bold = False
     End If
    Next i
  Next c
Application.StatusBar = "Formatting report..."
'Columns("A:IV").ColumnWidth = 10
m = maxR - DiffCount - 1
Application.StatusBar = False
Application.ScreenUpdating = True
MsgBox m & " cells contain same values!", vbInformation, _
"Compare " & ws1.Name & " with " & ws2.Name
End Sub

 

By running this macro you will find the matching cell of both the worksheets.