Compare Rows

[mralmackay]

Hi All,

I've, as I thought, crudely adapted the code below (created by Tom
Ogilvy) as I've got the following requirement/problem but I'm doing
something wrong as I can't get it to work for what I want.
- 2 spreadsheets (Columns A:R).
- Containing data from row 2 (row 1 is the header) through to Row1375
on Sheet1 and Row2937 on Sheet2.

I need to be able to report out where:
1) Any rows are unique within Sheet2 (don't exist in Sheet2)
2) Any rows are unique within Sheet1 (don't exist in Sheet2)

Ideally I'd like to have this reporting out to perhaps 2 different
worksheets, e.g. Sheet3 for scenario 1 and Sheet4 for scenario 2.

Has anyone got any code that would do this? Basically to explain what
happened, team had been working on a Shared Workbook and updating etc.
but something happened and they didn't realise they weren't using it
as a shared workbook in the meantime! Then somebody else was working
on it as a shared workbook so they're now both out of sync. I need to
understand where there are differences between the two to identify
these and have someone manually correct these.

Appreciate any help/pointers as always.
Thanks, Al.


Option Explicit

Sub ProcessData()
Dim rng1 As Range, rng2 As Range
Dim cell As Range, rw As Long
Dim cnt As Long, c As Range
Dim firstAddress As String
Dim i As Long, bFound As Boolean
With Worksheets("Sheet1")
Set rng1 = .Range(.Cells(1, 18), _
.Cells(Rows.Count, 18).End(xlUp))
End With
With Worksheets("Sheet2")
Set rng2 = .Range(.Cells(1, 18), _
.Cells(Rows.Count, 18).End(xlUp))
End With
rw = rng2.Rows(rng2.Rows.Count).Row + 1
For Each cell In rng1
Set c = rng2.Find(cell, LookIn:=xlValues)
If Not c Is Nothing Then
firstAddress = c.Address
bFound = False
Do
cnt = 0
For i = -2 To -6 Step -1
If cell.Offset(0, i) <> c.Offset(0, i) Then
Exit For
End If
cnt = cnt + 1
Next i
If cnt = 5 Then
bFound = True
Exit Do
End If
Set c = rng2.FindNext(c)
Loop While c.Address <> firstAddress
If bFound = False Then
cell.EntireRow.Copy _
Worksheets("sheet2").Cells(rw, 1)
rw = rw + 1
End If
Else
cell.EntireRow.Copy _
Worksheets("sheet2").Cells(rw, 1)
rw = rw + 1
End If
Next cell
End Sub

 

[Jim Cone]

Looks like your code is only checking column 18 to make the comparison.

Why don't you just download the free trial of my commercial add-in
"XL Companion". No registration is required.
It has a Match Rows feature under the "Compare Data" option.
It should do what you want. Download from the Products page at ...
http://www.realezsites.com/bus/primitivesoftware
--
Jim Cone
Portland, Oregon USA
(Excel Add-ins / Excel Programming)



<[email protected]>
wrote in message
Hi All,
I've, as I thought, crudely adapted the code below (created by Tom
Ogilvy) as I've got the following requirement/problem but I'm doing
something wrong as I can't get it to work for what I want.
- 2 spreadsheets (Columns A:R).
- Containing data from row 2 (row 1 is the header) through to Row1375
on Sheet1 and Row2937 on Sheet2.

I need to be able to report out where:
1) Any rows are unique within Sheet2 (don't exist in Sheet2)
2) Any rows are unique within Sheet1 (don't exist in Sheet2)

Ideally I'd like to have this reporting out to perhaps 2 different
worksheets, e.g. Sheet3 for scenario 1 and Sheet4 for scenario 2.

Has anyone got any code that would do this? Basically to explain what
happened, team had been working on a Shared Workbook and updating etc.
but something happened and they didn't realise they weren't using it
as a shared workbook in the meantime! Then somebody else was working
on it as a shared workbook so they're now both out of sync. I need to
understand where there are differences between the two to identify
these and have someone manually correct these.

Appreciate any help/pointers as always.
Thanks, Al.
-snip-