Often in a collaborative environment we receive data from team-workers in an Excel worksheet. This data may consist of additions or deletions of an earlier worksheet. Sometimes the Excel worksheet may just have been corrected. How can we compare the 2 worksheets quickly , identify the differences and then create a report. The worksheets may be in the same workbook or they may be in two different workbooks.

Watch the video before examining the VBA code given below:

Watch the video on Youtube.

Here’s the complete VBA code to compare 2 worksheets in 2 different workbooks and create a report of the differences in data:

Sub compare2Worksheets()
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

Set ws1 = ThisWorkbook.Worksheets(“Sheet1”)
With ws1.UsedRange
ws1row = .Rows.Count
ws1col = .Columns.Count
End With

‘Set ws2 = ThisWorkbook.Worksheets(“Sheet2”)
Set myworkbook = Workbooks.Open(“C:\exceltrainingvideos\compare-data-in-2-workbooks\Book2.xlsx”)
Set ws2 = myworkbook.Worksheets(“Sheet1”)
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

report.Worksheets(“Sheet1”).Activate
Cells.Clear
Range(“A1”) = “Name”
Range(“B1”) = “Salary”
erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).row

difference = 0
For col = 1 To maxcol
For row = 1 To maxrow
colval1 = “”
colval2 = “”
colval1 = ws1.Cells(row, col)
colval2 = ws2.Cells(row, col)
If colval1 <> colval2 Then
difference = difference + 1
Cells(row, col) = 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
myworkbook.Close SaveChanges:=False

If difference > 0 Then
Columns(“A:B”).ColumnWidth = 25
myfilename = InputBox(“Enter a file name”)
myfilename = myfilename & “.xlsx”
ActiveWorkbook.SaveAs Filename:=myfilename
End If

If difference = 0 Then
ActiveWorkbook.Close SaveChanges:=False
End If
MsgBox difference & ” cells contain different data! “, vbInformation, “Comparing Two Worksheets”
End Sub

Further reading:

Compare 2 Excel Worksheets cell by cell

Need to compare two Excel files for differences