VBA - Compare Two Spreadsheets

**ajocius** · 07-28-2005, 08:53 AM

Group,
Can someone show me a compact comparison routine that will check cells one to one, only checking cells within the boundaries of the last column with text in it and the last row with text in it. One spreadsheet may have 2000 rows and the other usually has a few more rows added, appearing in appearing in the beginning, middle or end of the spreadsheet. In some rows a single cell may change.
Everytime I try this problem, I get my self lost in mulitple For....Next statements and If....End If statements. Your assistance here can help a budding VBA programmer.

Thank you for your assistance.....

Tony

Bernie Deitrick · 07-28-2005, 10:05 AM

Tony,

I have written an add-in that will do a database style comparison - as long as your columns are in
the same order, it will highlight additions, deletions, and changes.

Contact me privately - reply to this message, and change my email address by taking out the spaces
and changing the dot to . - and I will send it to you.

HTH,
Bernie
MS Excel MVP

"ajocius" <[email protected]> wrote in message
news:[email protected]...
>
> Group,
> Can someone show me a compact comparison routine that will check
> cells one to one, only checking cells within the boundaries of the last
> column with text in it and the last row with text in it. One
> spreadsheet may have 2000 rows and the other usually has a few more
> rows added, appearing in appearing in the beginning, middle or end of
> the spreadsheet. In some rows a single cell may change.
> Everytime I try this problem, I get my self lost in mulitple
> For....Next statements and If....End If statements. Your assistance
> here can help a budding VBA programmer.
>
> Thank you for your assistance.....
>
> Tony
>
>
> --
> ajocius
> ------------------------------------------------------------------------
> ajocius's Profile: http://www.excelforum.com/member.php...o&userid=17695
> View this thread: http://www.excelforum.com/showthread...hreadid=390907
>

Dominic · 08-15-2005, 01:05 PM

Bernie,

I would like a copy of your add-in if you don't mind. Would you reply so I
can reply? Thanks.

"Bernie Deitrick" wrote:

> Tony,
>
> I have written an add-in that will do a database style comparison - as long as your columns are in
> the same order, it will highlight additions, deletions, and changes.
>
> Contact me privately - reply to this message, and change my email address by taking out the spaces
> and changing the dot to . - and I will send it to you.
>
> HTH,
> Bernie
> MS Excel MVP
>
>
> "ajocius" <[email protected]> wrote in message
> news:[email protected]...
> >
> > Group,
> > Can someone show me a compact comparison routine that will check
> > cells one to one, only checking cells within the boundaries of the last
> > column with text in it and the last row with text in it. One
> > spreadsheet may have 2000 rows and the other usually has a few more
> > rows added, appearing in appearing in the beginning, middle or end of
> > the spreadsheet. In some rows a single cell may change.
> > Everytime I try this problem, I get my self lost in mulitple
> > For....Next statements and If....End If statements. Your assistance
> > here can help a budding VBA programmer.
> >
> > Thank you for your assistance.....
> >
> > Tony
> >
> >
> > --
> > ajocius
> > ------------------------------------------------------------------------
> > ajocius's Profile: http://www.excelforum.com/member.php...o&userid=17695
> > View this thread: http://www.excelforum.com/showthread...hreadid=390907
> >
>
>
>

**Dnereb** · 08-15-2005, 02:14 PM

How about this:
Assuming you mean workbooks instead of spreadsheets programs

Option Explicit

'Returns True if all cells in the workbook have the same text content (you could add formulas if you need to)

Function CompareWorkbooks(Wbook1 As Workbook, Wbook2 As Workbook) As Boolean

Dim Wsheet1 As Worksheet
Dim Wsheet2 As Worksheet
Dim I As Long, Col As Long, Rw As Long


'for clarity:
CompareWorkbooks = False

'first check the basics, before checking all cells

If Wbook1.Worksheets.Count <> Wbook2.Worksheets.Count Then Exit Function

For I = 1 To Wbook1.Worksheets.Count
    If Wbook1.Worksheets(I).UsedRange.Columns.Count <> Wbook2.Worksheets(I).UsedRange.Columns.Count Then Exit Function
    If Wbook1.Worksheets(I).UsedRange.Rows.Count <> Wbook2.Worksheets(I).UsedRange.Rows.Count Then Exit Function
Next

'check all cells
For I = 1 To Wbook1.Worksheets.Count
    For Col = 1 To Wbook1.Worksheets(I).UsedRange.Columns.Count
        For Rw = 1 To Wbook1.Worksheets(I).UsedRange.Rows.Count
            'comment out the ones you do not need
            If Wbook1.Worksheets(I).Cells(Rw, Col).Text <> Wbook2.Worksheets(I).Cells(Rw, Col).Text Then Exit Function
            If Wbook1.Worksheets(I).Cells(Rw, Col).Value <> Wbook2.Worksheets(I).Cells(Rw, Col).Value Then Exit Function
            If Wbook1.Worksheets(I).Cells(Rw, Col).Formula <> Wbook2.Worksheets(I).Cells(Rw, Col).Formula Then Exit Function
            
        Next
    Next
Next
CompareWorkbooks = True
End Function
    
Sub test()

Dim Wbook1 As Workbook
Dim Wbook2 As Workbook

Set Wbook1 = Application.Workbooks.Open("c:\test\test2.xls")
Set Wbook2 = Application.Workbooks.Open("c:\test\test3.xls")


If CompareWorkbooks(Wbook1, Wbook2) Then
    MsgBox "the same!"
Else
    MsgBox "different!"
End If

keepITcool · 07-28-2005, 11:05 AM

a simple (but fast!) off the cuff routine
for a 1 on 1 comparison is below.

advanced addin try www.synkronizer.com
which matches row/column structure values/formulas
and does highlighting etc. (free trial,paid license)

or try bernie's addin.

Option Explicit
Sub CompareRanges()
Dim rng(2) As Range
Dim cDif As Collection
Dim r&, c&, i%, n&
Dim val(1), itm, dmp

For i = 0 To 1
On Error Resume Next
Set rng(i) = _
Application.InputBox( _
"Select a range." & vbLf & _
"OneCell/AllCells translates to UsedRange", Type:=8)
If rng(i) Is Nothing Then
i = i - 1
ElseIf rng(i).Count = 1 Or rng(i).Count = 2 ^ 24 Then
Set rng(i) = rng(i).Worksheet.UsedRange
End If
Next
On Error GoTo 0
If rng(0).Worksheet Is rng(1).Worksheet Then
If Not Intersect(rng(0), rng(1)) Is Nothing Then
MsgBox "Ranges overlap"
Exit Sub
End If
End If

Set cDif = New Collection
val(0) = rng(0).Value
val(1) = rng(1).Value
For r = 1 To Application.Min( _
rng(0).Rows.Count, rng(1).Rows.Count)
For c = 1 To Application.Min( _
rng(0).Columns.Count, rng(1).Columns.Count)
If StrComp(val(0)(r, c), val(1)(r, c), vbTextCompare) <> 0 Then
cDif.Add Array(r, c)
End If

Next
If r Mod 1000 = 1 Then Application.StatusBar = "Comparing row: " & r
Next

If cDif.Count > Rows.Count Then
MsgBox "Too many differences!"
Exit Sub
End If

Application.StatusBar = "Preparing output"
ReDim dmp(1 To cDif.Count, 1 To 4)
For Each itm In cDif
n = n + 1
With rng(0)(itm(0), itm(1))
dmp(n, 1) = .Address
dmp(n, 2) = .Value
End With
With rng(1)(itm(0), itm(1))
dmp(n, 3) = .Address
dmp(n, 4) = .Value
End With

Next
Application.StatusBar = False

Set rng(2) = Application.InputBox(cDif.Count & _
"differences found" & vbLf & _
"Where to dump?", Type:=8)
rng(2).Resize(cDif.Count, 4) = dmp

End Sub

--
keepITcool
| www.XLsupport.com | keepITcool chello nl | amsterdam

ajocius wrote :

>
> Group,
> Can someone show me a compact comparison routine that will check
> cells one to one, only checking cells within the boundaries of the
> last column with text in it and the last row with text in it. One
> spreadsheet may have 2000 rows and the other usually has a few more
> rows added, appearing in appearing in the beginning, middle or end of
> the spreadsheet. In some rows a single cell may change.
> Everytime I try this problem, I get my self lost in mulitple
> For....Next statements and If....End If statements. Your assistance
> here can help a budding VBA programmer.
>
> Thank you for your assistance.....
>
> Tony