Compare two Excel Worksheets Cell by Cell Using VBA

Home More Excel (VBA) Training Videos

How do you compare two worksheets cell by cell in the same workbook or in different workbooks? Excel VBA provides an elegant solution. First we define a few variables that can count the rows and columns so that we know how many cells are in use in the Excel worksheets. Next we assign the used ranges to the sheet with the maximum values. Now using a nested 'for loop' we access each cell in the used range and compare them. If the cells values are not equal we write them into a new workbook and also count the difference so that we tell the user about the number of cells that were not the same and also display both the values in the compared sheets. The displayed values are in the same cells in the new workbook as they appeared in the compared worksheets and highlighted appropriately  using formatting. We also use a command button so that the user can perform the task with a single click!

The macro or VBA code:
Sub Compare2WorkSheets(ws1 As Worksheet, ws2 As Worksheet)  
Dim ws1row As Long, ws2row As Long, ws1col As Integer, ws2col As Integer
Dim maxrow As Long, maxcol As Integer, colval1 As String, colval2 As String
Dim report As Workbook, difference As Long
Dim row As Long, col As Integer
Set report = Workbooks.Add
With ws1.UsedRange
ws1row = .Rows.Count
ws1col = .Columns.Count
End With
With ws2.UsedRange
ws2row = .Rows.Count
ws2col = .Columns.Count
End With
maxrow = ws1row
maxcol = ws1col
If maxrow < ws2row Then maxrow = ws2row
If maxcol < ws2col Then maxcol = ws2col
difference = 0
For col = 1 To maxcol
      For row = 1 To maxrow
      colval1 = ""
      colval2 = ""
      colval1 = ws1.Cells(row, col).Formula
      colval2 = ws2.Cells(row, col).Formula
      If colval1 <> colval2 Then
     difference = difference + 1
     Cells(row, col).Formula = colval1 & "<> " & colval2
     Cells(row, col).Interior.Color = 255
     Cells(row, col).Font.ColorIndex = 2
     Cells(row, col).Font.Bold = True
      End If
Next row
Next col
Columns("A:B").ColumnWidth = 25
report.Saved = True
If difference = 0 Then
report.Close False
End If
Set report = Nothing
MsgBox difference & " cells contain different data! ", vbInformation, "Comparing Two Worksheets"
End Sub

Private Sub CommandButton1_Click()
'Compare2WorkSheets Worksheets("Sheet1"), Worksheets("Sheet2")
Set myWorkbook1 = Workbooks.Open("C:\familycomputerclub-website\Excel2007\testcompare2.xlsx")
Compare2WorkSheets Workbooks("testcompare1.xlsm").Worksheets("Sheet1"), myWorkbook1.Worksheets("Sheet1")
End Sub

Watch the Excel training video to see how this interesting VBA solution for comparing two Excel worksheets cell by cell is implemented:

Watch the video on our youtube channel
Home More Excel (VBA) Training Videos