View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
keepITcool keepITcool is offline
external usenet poster
 
Posts: 2,253
Default VBA - Compare Two Spreadsheets


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