PDA

View Full Version : Compare two workbooks and highlight the differences in the third workbook



itsme2216
05-17-2017, 09:33 PM
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
For Each WS In Workbooks("Solution_Project.xlsx").Worksheets
Call CompareWorkbooks(WS, Workbooks("Template_Project .xlsx").Worksheets(WS.Name))
Next
End Sub

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

Worksheets.Add.Name = WS1.Name ' new book for the results
Range("A1:D1").Value = Array("Address", "Difference", WS1.Parent.Name, WS2.Parent.Name)
Range("A2").Select
For iRow = 1 To Application.Max(WS1.Range("A1").SpecialCells(xlLastCell).Row, _
WS2.Range("A1").SpecialCells(xlLastCell).Row)
For iCol = 1 To 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
End If
Else
NoteError R1.Address, "Text Mismatch", R1.Value, R2.Value
End If
If TypeName(R2.Value) = "" Then
NoteError R1.Address, "Value Deleted", R1.Value, "**Missing Value**"
End If
If TypeName(R1.Value) = "" Then
NoteError R1.Address, "Value Added", "**Missing Value**", R2.Value
End If
End If

' 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)
End If
Else
NoteError R1.Address, "Formula Deleted", Mid(R1.Formula, 2), "**no formula**"
End If
Else
If R2.HasFormula Then
NoteError R1.Address, "Formula Embedded", "**no formula**", Mid(R2.Formula, 2)
End If
End If
If R1.NumberFormat <> R2.NumberFormat Then
NoteError R1.Address, "NumberFormat", R1.NumberFormat, R2.NumberFormat
End If
Next iCol
Next iRow
With ActiveSheet.UsedRange.Columns
.AutoFit
.HorizontalAlignment = xlLeft
End With
End Sub

Sub NoteError(Address As String, What As String, 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
End If
End Sub

werafa
05-22-2017, 03:17 AM
have you thought about disabling user input/interaction while the sheet is running?

werafa

itsme2216
05-22-2017, 03:33 AM
How do we do that

werafa
05-22-2017, 04:10 AM
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
05-22-2017, 04:37 AM
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
05-22-2017, 08:16 AM
It gives me error : subscript out of range on this line:

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

mdmackillop
05-22-2017, 08:23 AM
Too many quotes
Workbooks(""Template