Sub All_Diffs_Highlighted()
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Cell As Range
Dim sBook As String
'
If Workbooks.Count < 2 Then
MsgBox "Error: Only one Workbook is open" & vbCr & _
"Open a 2nd Workbook and run this macro again."
Exit Sub
End If
'
Set wb1 = ThisWorkbook
For Each wb2 In Workbooks
If wb2.Name <> wb1.Name Then Exit For
Next
'
On Error Resume Next
ReDo1:
Application.DisplayAlerts = False
sBook = Application.InputBox(Prompt:= _
"Compare this workbook (" & wb1.Name & _
") to...?", _
Title:="Compare to what workbook?", _
Default:=wb2.Name, _
Type:=2)
If sBook = "False" Then Exit Sub
If Workbooks(sBook) Is Nothing Then
MsgBox "Workbook: " & sBook & " is not open."
GoTo ReDo1
Else
Set wb2 = Workbooks(sBook)
End If
'
Application.ScreenUpdating = False
For Each ws1 In wb1.Sheets
If Not wb2.Sheets(ws1.Name) Is Nothing Then
Set ws2 = wb2.Sheets(ws1.Name)
For Each Cell In ws1.UsedRange
If Cell.Formula <> ws2.Range(Cell.Address).Formula Then
Cell.Interior.ColorIndex = 35
ws2.Range(Cell.Address). _
Interior.ColorIndex = 35
End If
Next Cell
If ws1.UsedRange.Rows.Count <> _
ws2.UsedRange.Rows.Count Or _
ws1.UsedRange.Columns.Count <> _
ws2.UsedRange.Columns.Count Then
For Each Cell In ws2.UsedRange
If Cell.Formula <> ws1.Range(Cell.Address).Formula Then
Cell.Interior.ColorIndex = 35
ws1.Range(Cell.Address). _
Interior.ColorIndex = 35
End If
Next Cell
End If
End If
Next ws1
'
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Sub Clear_Highlights_this_Sheet()
ActiveSheet.UsedRange. _
Interior.ColorIndex = xlNone
End Sub
Sub Clear_Highlights_All_Sheets()
Dim sht As Worksheet
For Each sht In Sheets
sht.UsedRange.Interior.ColorIndex = xlNone
Next
End Sub
Bookmarks