Sub RunCompare()
With Excel.Application
.ScreenUpdating = False
.Cursor = xlWait
.Calculation = xlCalculationManual
.StatusBar = False
.DisplayAlerts = False
End With
Dim xusedrangeColumns As Integer
Dim yusedrangeColumns As Integer
Dim xusedrangeRows As Integer
Dim yusedrangeRows As Integer
Dim xRow As Range
Dim xColumn As Range
Dim xtext As String
Dim i As Integer
Dim h As Integer
Sheets("Sheet1").Cells.Interior.ColorIndex = xlNone
Sheets("Sheet2").Cells.Interior.ColorIndex = xlNone
xusedrangeColumns = Sheets("Sheet1").UsedRange.Columns.Count
yusedrangeColumns = Sheets("Sheet2").UsedRange.Columns.Count
xusedrangeRows = Sheets("Sheet1").UsedRange.Rows.Count
yusedrangeRows = Sheets("Sheet2").UsedRange.Rows.Count
If (xusedrangeColumns = yusedrangeColumns) And (xusedrangeRows = yusedrangeRows) Then
Call compareSheets("Sheet1", "Sheet2")
ElseIf xusedrangeRows <> yusedrangeRows Then
For Each xRow In Sheets("Sheet1").Rows
With Sheets("Sheet1").UsedRange.Rows
FirstRow = .Row + i
FirstCol = .Column
Firstvalue = Sheets("Sheet1").Cells(FirstRow, FirstCol).Value
End With
With Sheets("Sheet2").UsedRange.Columns
SecondRow = .Row + i
SecondCol = .Column
SecondValue = Sheets("Sheet2").Cells(SecondRow, SecondCol).Value
End With
If Firstvalue = "" Or SecondValue = "" Then
Do Until Firstvalue <> "" Or (FirstCol + 1 = xusedrangeColumns) Or SecondValue <> ""
With Sheets("Sheet1").UsedRange.Rows
FirstRow = .Row + i
FirstCol = .Column + h
If FirstRow < xusedrangeRows Then
Firstvalue = Sheets("Sheet1").Cells(FirstRow, FirstCol).Value
Else
If (yusedrangeRows - xusedrangeRows) < 0 Then
MsgBox ("There is/are " & Abs((yusedrangeRows - xusedrangeRows)) & " extra Rows in 'Sheet1'; If nothing is yellowed, it's not clear (by rows) where the difference begins. Simulate " & Abs((yusedrangeRows - xusedrangeRows)) & " row(s) in 'Sheet2' and try again to show the difference among columns")
Sheets("Sheet2").Select
Else
MsgBox ("There is/are " & Abs((yusedrangeRows - xusedrangeRows)) & " extra Rows in 'Sheet2'; If nothing is yellowed, it's not clear (by rows) where the difference begins. Simulate " & Abs((yusedrangeRows - xusedrangeRows)) & " row(s) in 'Sheet1' and try again to show the difference among columns")
Sheets("Sheet1").Select
End If
With Excel.Application
.ScreenUpdating = True
.Cursor = xlDefault
.Calculation = xlCalculationAutomatic
.StatusBar = True
.DisplayAlerts = True
End With
Exit Sub
End If
End With
With Sheets("Sheet2").UsedRange.Columns
SecondRow = .Row + i
SecondCol = .Column + h
If FirstRow < xusedrangeRows Then
SecondValue = Sheets("Sheet2").Cells(SecondRow, SecondCol).Value
Else
If (yusedrangeRows - xusedrangeRows) < 0 Then
MsgBox ("There is/are " & Abs((yusedrangeRows - xusedrangeRows)) & " extra Row(s) in 'Sheet1'; If nothing is yellowed, it's not clear (by row(s)) where the difference begins. Simulate " & Abs((yusedrangeRows - xusedrangeRows)) & " row(s) in 'Sheet2' and try again to show the difference among columns")
Sheets("Sheet2").Select
Else
MsgBox ("There is/are " & Abs((yusedrangeRows - xusedrangeRows)) & " extra Row(s) in 'Sheet2'; If nothing is yellowed, it's not clear (by row(s)) where the difference begins. Simulate " & Abs((yusedrangeRows - xusedrangeRows)) & " row(s) in 'Sheet1' and try again to show the difference among columns")
Sheets("Sheet1").Select
End If
With Excel.Application
.ScreenUpdating = True
.Cursor = xlDefault
.Calculation = xlCalculationAutomatic
.StatusBar = True
.DisplayAlerts = True
End With
Exit Sub
End If
End With
h = h + 1
Loop
h = 0
If (Firstvalue <> SecondValue) Or (Firstvalue = "" And SecondValue = "") Then
xRow.Interior.Color = vbYellow
End If
End If
i = i + 1
Next
MsgBox ("There are " & (yusedrangeRows - xusedrangeRows) & " extra Row(s) in 'Sheet1'; If nothing is yellowed, it's not clear (by row(s)) where the difference is. Simulate one row in 'Sheet2' and try again to show the difference among columns")
Sheets("Sheet2").Select
ElseIf xusedrangeColumns <> yusedrangeColumns Then
For Each xColumn In Sheets("Sheet1").Columns
With Sheets("Sheet1").UsedRange.Columns
FirstRow = .Row
FirstCol = .Column + i
Firstvalue = Sheets("Sheet1").Cells(FirstRow, FirstCol).Value
End With
With Sheets("Sheet2").UsedRange.Columns
SecondRow = .Row
SecondCol = .Column + i
SecondValue = Sheets("Sheet2").Cells(SecondRow, SecondCol).Value
End With
If Firstvalue = "" Or SecondValue = "" Then
Do Until Firstvalue <> "" Or SecondValue <> ""
With Sheets("Sheet1").UsedRange.Columns
FirstRow = .Row + h
FirstCol = .Column + i
If FirstRow < xusedrangeRows Then
Firstvalue = Sheets("Sheet1").Cells(FirstRow, FirstCol).Value
Else
If (xusedrangeColumns - yusedrangeColumns) < 0 Then
MsgBox ("There is/are " & Abs((xusedrangeColumns - yusedrangeColumns)) & " extra Column(s) in 'Sheet2'; If nothing is yellowed, it's not clear (by column(s)) where the difference begins. Simulate " & Abs((xusedrangeColumns - yusedrangeColumns)) & " column(s) in 'Sheet1' and try again to show the difference among rows")
Sheets("Sheet1").Select
Else
MsgBox ("There is/are " & Abs((xusedrangeColumns - yusedrangeColumns)) & " extra Column(s) in 'Sheet1'; If nothing is yellowed, it's not clear (by column(s)) where the difference begins. Simulate " & Abs((xusedrangeColumns - yusedrangeColumns)) & " column(s) in 'Sheet2' and try again to show the difference among rows")
Sheets("Sheet2").Select
End If
With Excel.Application
.ScreenUpdating = True
.Cursor = xlDefault
.Calculation = xlCalculationAutomatic
.StatusBar = True
.DisplayAlerts = True
End With
Exit Sub
End If
End With
With Sheets("Sheet2").UsedRange.Columns
SecondRow = .Row + h
SecondCol = .Column + i
If FirstRow < xusedrangeRows Then
SecondValue = Sheets("Sheet2").Cells(SecondRow, SecondCol).Value
Else
If (xusedrangeColumns - yusedrangeColumns) < 0 Then
MsgBox ("There is/are " & Abs((xusedrangeColumns - yusedrangeColumns)) & " extra Column(s) in 'Sheet2'; If nothing is yellowed, it's not clear (by Columns) where the difference begins. Simulate " & Abs((xusedrangeColumns - yusedrangeColumns)) & " column(s) in 'Sheet1' and try again to show the difference among rows")
Sheets("Sheet1").Select
Else
MsgBox ("There is/are " & Abs((xusedrangeColumns - yusedrangeColumns)) & " extra Column(s) in 'Sheet1'; If nothing is yellowed, it's not clear (by Columns) where the difference begins. Simulate " & Abs((xusedrangeColumns - yusedrangeColumns)) & " column(s) in 'Sheet2' and try again to show the difference among rows")
Sheets("Sheet2").Select
End If
With Excel.Application
.ScreenUpdating = True
.Cursor = xlDefault
.Calculation = xlCalculationAutomatic
.StatusBar = True
.DisplayAlerts = True
End With
Exit Sub
End If
End With
h = h + 1
Loop
h = 0
If Firstvalue <> SecondValue Then
xColumn.Interior.Color = vbYellow
End If
End If
i = i + 1
Next
MsgBox ("There are " & (xusedrangeColumns - yusedrangeColumns) & " extra Column(s) in 'Sheet2'; If nothing is yellowed, it's not clear (by rows) where the difference is. Simulate one row in 'Sheet1' and try again to show the difference among rows")
Sheets("Sheet1").Select
End If
With Excel.Application
.ScreenUpdating = True
.Cursor = xlDefault
.Calculation = xlCalculationAutomatic
.StatusBar = True
.DisplayAlerts = True
End With
End Sub
'This works if both sheets have the same size
Sub compareSheets(shtBefore As String, shtAfter As String)
Dim mycell As Range
Dim mydiffs As Double
For Each mycell In ActiveWorkbook.Worksheets(shtAfter).UsedRange
xtext1 = mycell.Value
If Not mycell.Value = ActiveWorkbook.Worksheets(shtBefore).Cells(mycell.Row, mycell.Column).Value Then
mycell.Interior.Color = vbYellow
mydiffs = mydiffs + 1
End If
Next
MsgBox mydiffs & " differences found", vbInformation
ActiveWorkbook.Sheets(shtAfter).Select
End Sub