Modify Compare Worksheet Macro...Please Help!!!!

[mbarnett]

Hi All,

Sorry for the long desc -

I have two ranges I want to compare. Range one is in Sheet1 and range two is in Sheet2. Both ranges share the same ID number(the ID numbers are not in the same order in in the worksheets and I can't sort them, because it will effect other data in the workbook).

For each ID in Sheet1 I want the macro to find the matching ID in Sheet2 and compare the data in that row to the data in Sheet1. In both ranges there are a total of 5 columns. Column 1 contains the Unique ID and the other columns contain key data points I want to compare.

If the macro finds any mistmatch I want it to spit the mismatch per unique ID to Sheet3. I have the below macro, but I can't figure out how to modify it to do what I just described. Any suggestions would be greatly appreciated.

Sub CompareSheets()
Dim shtA As Worksheet
Dim shtB As Worksheet
Dim shtE As Worksheet
Dim rng As Range
Dim a As Range
Dim b As Range
Dim nErrorOutRow As Long
Dim nFirstRow As Long
Dim nLastRow As Long
Dim nFirstCol As Integer
Dim nLastCol As Integer

' Update the following with the actual sheet names:
Set shtA = Worksheets("Sheet1")
Set shtB = Worksheets("Sheet2")
Set shtE = Worksheets("Sheet3")

' Determine rows and cols to test
With shtA.Range("one")
nFirstRow = .Cells(1, 1).Row
nLastRow = .Rows.Count + .Cells(1, 1).Row - 1
nFirstCol = .Cells(1, 1).Column
nLastCol = .Columns.Count + .Cells(1, 1).Column - 1
End With
With shtB.Range("two")
nFirstRow = WorksheetFunction.Min(nFirstRow, .Cells(1, 1).Row)
nLastRow = WorksheetFunction.Max(nLastRow, .Rows.Count + .Cells(1, 1).Row - 1)
nFirstCol = WorksheetFunction.Min(nFirstCol, .Cells(1, 1).Column)
nLastCol = WorksheetFunction.Max(nLastCol, .Columns.Count + .Cells(1, 1).Column - 1)
End With
Set rng = Range(Cells(nFirstRow, nFirstCol), Cells(nLastRow, nLastCol))

' Set up exceptions sheet
shtE.Cells.Clear
shtE.Cells(1, 1) = "Ref."
shtE.Cells(1, 2) = shtA.Name
shtE.Cells(1, 3) = shtB.Name
nErrorOutRow = 2

' Process all cells and compare
Application.ScreenUpdating = False
For Each a In shtA.Range(rng.Address)
Set b = shtB.Range(a.Address)
If a.Value <> b.Value Then
shtE.Cells(nErrorOutRow, 1) = b.Address(0, 0)
'shtE.Cells(nErrorOutRow, 1) = a.Value
shtE.Cells(nErrorOutRow, 2) = a.Value
shtE.Cells(nErrorOutRow, 3) = b.Value
nErrorOutRow = nErrorOutRow + 1
End If
Next a
Application.ScreenUpdating = True
shtE.Activate

' Clean up and terminate
Set shtA = Nothing
Set shtB = Nothing
Set shtE = Nothing
Set rng = Nothing
Set a = Nothing
Set b = Nothing
End Sub

 

[mbarnett]

Hi All,

I found this macro on the site. It is shorter,but I can't get it to work exactly the way I want. Any suggestions.

Sub stance()
Dim c1 As Range, c2 As Range
Dim lRow As Long

lRow = 1
For Each c1 In Worksheets("Sheet1").UsedRange.Columns(1).Cells

Set c2 = Worksheets("Sheet2").UsedRange.Columns(1).Cells _
.Find(c1, LookIn:=xlValues)
If Not c2 Is Nothing Then
If c1.Offset(0, 1).Value <> c2.Offset(0, 1).Value Or _
c1.Offset(0, 2).Value <> c2.Offset(0, 2).Value Then
c2.EntireRow.Copy Worksheets("Sheet3").Rows(lRow)
lRow = lRow + 1
End If
End If
Next
End Sub

 

[KenWright]

Don't know how automated it has to be, but personally I will always use a Pivot table for this kind of analysis. Just in case it is of any use I'll outline how:-

Sheet1 -

ID1 aa bb cc dd
a 3 153 163 142
b 83 173 159 75
c 175 12 190 73
d 154 11 119 94
e 125 130 53 56
f 165 118 198 183
g 140 197 49 107
h 200 136 4 116
i 21 160 57 10
j 77 61 190 196
k 56 33 33 130

Sheet 2:-

ID1 aa bb cc dd
a 3 153 163 142
b 83 173 159 75
c 175 12 190 73
d 154 11 119 94
e 125 130 53 56
f 165 118 198 183
g 140 197 49 107
h 178 110 350 301
i 110 270 103 36
j 13 130 317 119
k 95 193 102 137

Make a copy of sheet1 and Insert a column at Col A and put LIST1 against every record, eg:-

List ID1 aa bb cc dd
List1 a 3 153 163 142
List1 b 83 173 159 75
List1 c 175 12 190 73
List1 d 154 11 119 94
List1 e 125 130 53 56
List1 f 165 118 198 183
List1 g 140 197 49 107
List1 h 200 136 4 116
List1 i 21 160 57 10
List1 j 77 61 190 196
List1 k 56 33 33 130

Sheet 2, copy data and paste below the above, and THEN, put -1 in an empty cell, select all the data for List 2 and do Edit / paste Special / multiply. Finally put LIST2 against each record. Data now looks like:-

List ID1 aa bb cc dd
List1 a 3 153 163 142
List1 b 83 173 159 75
List1 c 175 12 190 73
List1 d 154 11 119 94
List1 e 125 130 53 56
List1 f 165 118 198 183
List1 g 140 197 49 107
List1 h 200 136 4 116
List1 i 21 160 57 10
List1 j 77 61 190 196
List1 k 56 33 33 130
List2 a -3 -153 -163 -142
List2 b -83 -173 -159 -75
List2 c -175 -12 -190 -73
List2 d -154 -11 -119 -94
List2 e -125 -130 -53 -56
List2 f -165 -118 -198 -183
List2 g -140 -197 -49 -107
List2 h -178 -110 -350 -301
List2 i -110 -270 -103 -36
List2 j -13 -130 -317 -119
List2 k -95 -193 -102 -137

Select all the data and do Data / Pivot Table and pivot Chart report. Hit next / next / Finish. Drag the LIST field to the top of the table, the ID field to the left of the table, and then field aa to the middle. You can switch aa for bb, cc etc or even put them all in at any time.

You will now have a report that looks like this


Sum of aa List
ID1 List1 List2 Grand Total
a 3 -3 0
b 83 -83 0
c 175 -175 0
d 154 -154 0
e 125 -125 0
f 165 -165 0
g 140 -140 0
h 200 -178 22
i 21 -110 -89
j 77 -13 64
k 56 -95 -39
Grand Total 1199 -1241 -42

The numbers that are not 0 in the TOTAL column indicate a delta between the records for that ID. makes it very easy indeed to spot deltas, and indeed missing IDs or New IDs as they will have value in one list and a blank in the other.

Regards
Ken..............

----------------------------------------------------------------------------
It's easier to beg forgiveness than ask permission

----------------------------------------------------------------------------

 

[mbarnett]

Hi KW,

Thanks for the suggestion, but I really need a macro to run thru the ranges.