Comparing Spreadsheets
Posted by Danielle on May 08, 2001 2:13 AM
Hello!!
Does anyone know of an easy way to compare 2 spreadsheets? The situation is that we have 2 large spreadsheets that should be exactly the same but are returning a different final value. We would like to be able to compare the two and pull out the differences so we can figure out why the total values differ between the two.
Thanks!!
danielle
Posted by Ivan Moala on May 08, 2001 5:29 AM
Hi danielle
have a try with the following macro;
Forgot where I got this from (Sorry to prgmer)
This procedure creates a new workbook which lists the comparison results for
each worksheet in the two workbooks of interest. Each of the two workbooks
should be open prior to running this procedure. Replace the dummy names in the
the DoCompare sub with appropriate filenames.
Sub DoCompare()
Dim WS As Worksheet
Workbooks.Add
For Each WS In Workbooks("SomeBook.xls").Worksheets
CompareSheets WS, Workbooks("SomeOther.xls").Worksheets(WS.Name)
Next
End Sub
Sub CompareSheets(WS1 As Worksheet, WS2 As Worksheet)
Dim iRow As Integer, iCol As Integer
Dim R1 As Range, 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, "Type", 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, "Double", R1.Value, R2.Value
End If
Else
NoteError R1.Address, "Value", R1.Value, R2.Value
End If
End If
' record formulae without leading "=" to avoid them being evaluated
If R1.HasFormula Then
If R2.HasFormula Then
If R1.Formula <> R2.Formula Then
NoteError R1.Address, "Formula", Mid(R1.Formula, 2), Mid(R2.Formula, 2)
End If
Else
NoteError R1.Address, "Formula", Mid(R1.Formula, 2), "**no formula**"
End If
Else
If R2.HasFormula Then
NoteError R1.Address, "Formula", "**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
HTH
Ivan
Posted by danielle on May 08, 2001 6:59 AM
Hi Ivan,
Thanks for your response.
I am running the macro but I keep getting back the following error :
"Cannot rename a sheet to the same name as another sheet, a referenced object library or a workbook referenced by Visual Basic"
When I click on the Debug button from here it highlights the line
"Worksheets.Add.Name = WS1.Name ' new book for the results"
The only thing that I have changed from your copy of the macro are the .xls filenames at the top. Do I need to change anything else??
Thanks again for your help.
Danielle
Posted by Ivan Moala on May 08, 2001 11:36 PM
Hi Danielle
Try this;
Sub DoCompare()
Dim WS As Worksheet
Workbooks.Add
For Each WS In Workbooks("SomeBook.xls").Worksheets
CompareSheets WS, Workbooks("OtherBook.xls").Worksheets(WS.Name)
Next
End Sub
Sub CompareSheets(WS1 As Worksheet, WS2 As Worksheet)
Dim iRow As Integer, iCol As Integer
Dim R1 As Range, R2 As Range
Worksheets.Add.Name = "Result-" & 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, "Type", 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, "Double", R1.Value, R2.Value
End If
Else
NoteError R1.Address, "Value", R1.Value, R2.Value
End If
End If
' record formulae without leading "=" to avoid them being evaluated
If R1.HasFormula Then
If R2.HasFormula Then
If R1.Formula <> R2.Formula Then
NoteError R1.Address, "Formula", Mid(R1.Formula, 2), Mid(R2.Formula, 2)
End If
Else
NoteError R1.Address, "Formula", Mid(R1.Formula, 2), "**no formula**"
End If
Else
If R2.HasFormula Then
NoteError R1.Address, "Formula", "**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
Ivan
