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.