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.