Compare two workbooks and highlight the differences in the third workbook

[itsme2216]

I have created a macro which compares all the sheets of my Workbook1 with the sheets of Workbook2 and highlight the differences in the third workbook (sheet by sheet)
I have categorized the differences into different headers Like:-
List
Entered Value Changed.- Text When Value/Text is replaced by text/value
Value Mismatch Value replaced by incorrect value
Text Mismatch Value replaced by incorrect text
Incorrect Formula Formula replaced by different formula
Formula Deleted Formula is deleted
Formula Embedded Formula added
Value Deleted Missing Value
Value Added New Value is added
Now my problem is Currently, while comparing the two workbooks if the any of the value is deleted from any sheet of Workbook2 then while comparing it with Workbook1 it is categorizing under "Entered Value Changed.- Text" but I want it to come under "Value Deleted"
and second issue is Currently, while comparing the two workbooks if the any of the value is added from any sheet of Workbook2 then while comparing it with Workbook1 it is categorizing under "Entered Value Changed.- Text" but I want it to come under "Value Added"
I guess the below two lines needs to be modified:


If TypeName(R2.Value)=""Then
NoteError R1.Address,"Value Deleted", R1.Value,"**Missing Value**"

If TypeName(R1.Value)=""Then
NoteError R1.Address,"Value Added","**Missing Value**", R2.Value

Overall Code:-

Sub ExCompare()
Dim WS As Worksheet
Workbooks.Add
ForEach WS In Workbooks("Solution_Project.xlsx").Worksheets
Call CompareWorkbooks(WS, Workbooks("Template_Project .xlsx").Worksheets(WS.Name))
Next
EndSub

Sub CompareWorkbooks(ByVal WS1 As Worksheet,ByVal WS2 As Worksheet)
Dim iRow AsInteger
Dim iCol AsInteger
Dim R1 As Range
Dim R2 As Range

Worksheets.Add.Name = WS1.Name ' new book for the results
Range("A11").Value = Array("Address","Difference", WS1.Parent.Name, WS2.Parent.Name)
Range("A2").Select
For iRow =1To Application.Max(WS1.Range("A1").SpecialCells(xlLastCell).Row, _
WS2.Range("A1").SpecialCells(xlLastCell).Row)
For iCol =1To Application.Max(WS1.Range("A1").SpecialCells(xlLastCell).Column, _
WS2.Range("A1").SpecialCells(xlLastCell).Column)

Set R1 = WS1.Cells(iRow, iCol)
Set R2 = WS2.Cells(iRow, iCol)

' compare the types to avoid getting VBA type mismatch errors.
If TypeName(R1.Value)<> TypeName(R2.Value)Then
NoteError R1.Address,"Entered Value Changed.- Text", R1.Value, R2.Value
ElseIf R1.Value <> R2.Value Then
If TypeName(R1.Value)="Double"Then
If Abs(R1.Value - R2.Value)> R1.Value *10^(-12)Then
NoteError R1.Address,"Value Mismatch", R1.Value, R2.Value
EndIf
Else
NoteError R1.Address,"Text Mismatch", R1.Value, R2.Value
EndIf
If TypeName(R2.Value)=""Then
NoteError R1.Address,"Value Deleted", R1.Value,"**Missing Value**"
EndIf
If TypeName(R1.Value)=""Then
NoteError R1.Address,"Value Added","**Missing Value**", R2.Value
EndIf
EndIf

' record formula without leading "=" to avoid them being evaluated
If R1.HasFormula Then
If R2.HasFormula Then
If R1.Formula <> R2.Formula Then
NoteError R1.Address,"Incorrect Formula", Mid(R1.Formula,2), Mid(R2.Formula,2)
EndIf
Else
NoteError R1.Address,"Formula Deleted", Mid(R1.Formula,2),"**no formula**"
EndIf
Else
If R2.HasFormula Then
NoteError R1.Address,"Formula Embedded","**no formula**", Mid(R2.Formula,2)
EndIf
EndIf
If R1.NumberFormat <> R2.NumberFormat Then
NoteError R1.Address,"NumberFormat", R1.NumberFormat, R2.NumberFormat
EndIf
Next iCol
Next iRow
With ActiveSheet.UsedRange.Columns
.AutoFit
.HorizontalAlignment = xlLeft
EndWith
EndSub

Sub NoteError(Address AsString, What AsString, V1, V2)
ActiveCell.Resize(1,4).Value = Array(Address, What, V1, V2)
ActiveCell.Offset(1,0).Select
If ActiveCell.Row = Rows.Count Then
MsgBox "Too many differences", vbExclamation
End
EndIf
EndSub

[werafa]

have you thought about disabling user input/interaction while the sheet is running?

werafa

[itsme2216]

How do we do that

[werafa]

Application.ScreenUpdating = False
Application.EnableEvents = False

and

Application.Interactive =False

but be sure your code works before you disable user interaction (and set everything to true at the end of your code)
I often also add Application.Calculation = xlmanual. and create a sub that manages everything, eg.

sub SuperCharge()

with application
.calculation = xlManual 
.ScreenUpdating = False
.EnableEvents = False
'.interactive = false
end with
end sub

sub ResetApp()

with application
.Calculation = xlautomatic
.ScreenUpdating = true
.EnableEvents = true
.interactive = true
end with
end sub

[mdmackillop]

Add some error handling to ensure things are reset if the code errors.

Sub test()


On Error GoTo Exits
Call SuperCharge


'Do all my stuff


Exits:
Call ResetApp
End Sub

[itsme2216]

It gives me error : subscript out of range on this line:

Call CompareWorkbooks(WS, Workbooks(""Template_Project .xlsx").Worksheets(WS.Name))

[mdmackillop]

Too many quotes
Workbooks(""Template