Sheet Compare Macro...

[Guest]

Sheet 1 contains 10,000 customers all uniquely identified by a customer
number in column A, with extra details stretching to column Z. Sheet 2
contains up to 10,000 customer details that are identical to sheet 1 in terms
of customer number, but their additional details might have been changed. I
need a macro that will compare sheet 1 and sheet 2 by customer number. If any
row on sheet 2 is different to sheet 1 then the changed data sheet 2 will be
transferred into sheet 1. Make sense?

This has been driving me nuts...any help appreciated...

Gordon.

 

[Dave Peterson]

How about something like this?

Option Explicit
Sub testme()

Application.ScreenUpdating = False

Dim MstrWks As Worksheet
Dim NewWks As Worksheet

Dim MstrKeyRange As Range
Dim NewKeyRange As Range
Dim myCell As Range
Dim destCell As Range

Dim LastCol As Long

Dim iCol As Long
Dim res As Variant

Set MstrWks = ActiveWorkbook.Worksheets("sheet1")
Set NewWks = ActiveWorkbook.Worksheets("sheet2")

With MstrWks
Set MstrKeyRange = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
.Cells.Interior.ColorIndex = xlNone 'remove all fill color!
End With

With NewWks
Set NewKeyRange = .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
End With

LastCol = 26 'A to Z
MstrWks.Columns(LastCol + 1).Clear
For Each myCell In MstrKeyRange.Cells
With myCell
res = Application.Match(.Value, NewKeyRange, 0)
If IsError(res) Then
.Parent.Cells(myCell.Row, LastCol + 1).Value _
= "Not on other sheet"
Else
For iCol = 1 To LastCol - 1
If .Offset(0, iCol).Value _
= NewKeyRange(res).Offset(0, iCol).Value Then
'do nothing, they match
Else
.Offset(0, iCol).Value _
= NewKeyRange(res).Offset(0, iCol).Value
.Offset(0, iCol).Interior.ColorIndex = 3
.Parent.Cells(myCell.Row, LastCol + 1).Value _
= "Changed"
End If
Next iCol
End If
End With
Next myCell

'check for newly added entries
For Each myCell In NewKeyRange.Cells
With myCell
res = Application.Match(.Value, MstrKeyRange, 0)
If IsError(res) Then
'missing from new workbook!
With MstrWks
Set destCell _
= .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
End With
.Resize(1, LastCol).Copy _
Destination:=destCell
destCell.Parent.Cells(destCell.Row, LastCol + 1).Value _
= "Added"
Else
'already in the master
'don't do anything
End If
End With
Next myCell

Application.ScreenUpdating = True

End Sub



It removes the fill color and marks the differences in red (.colorindex =3).

It also adds an indicator to column AA with the change type.

And if you added more records in Sheet2, it'll add them to the bottom and mark
them "added".

And if the key was missing from the other sheet, it puts a message there, too.

Make sure you try it out against a test copy of your workbook--just in case (or
close without saving if it breaks things too much!).