Update to List-Comparison Macro to Show What Data Has Changed?

H

Harold Shea

Many months ago, someone here very helpfully gave me the following macro:
Sub Update()
Dim A As Integer, ML As Integer, UL As Integer
ML = 2 'MasterList Start Row
UL = 2 'UpdateList Start Row
Do Until Sheets("Weekly Update").Cells(UL, 2) = ""
Do Until Sheets("Master List").Cells(ML, 2) = ""
If Sheets("Master List").Cells(ML, 2) = Sheets("Weekly Update").Cells(UL, 2)
Then
Worksheets("Weekly Update").Activate
Sheets("Weekly Update").Range(Cells(UL, 1), Cells(UL, 14)).Copy _
Sheets("Master List").Cells(ML, 1)
ML = 2
Exit Do
End If
ML = ML + 1
If Sheets("Master List").Cells(ML, 2) = "" Then
Worksheets("Weekly Update").Activate
Sheets("Weekly Update").Range(Cells(UL, 1), Cells(UL, 14)).Copy _
Sheets("Master List").Cells(ML, 1)
End If
Loop
UL = UL + 1
ML = 2
Loop
End Sub

What this does is, for each row in a sheet called "Weekly Update," compare
the value in Column B to the values in Column B on the sheet called "Master
List." When the macro finds a match in "Master List," it copies and pastes
the contents of the corresponding row (Columns A through N) from "Weekly
Update" onto it. If a line item in "Weekly Update" is totally new (meaning
that there is no matching value in Column B of "Master List") it adds the row
to the bottom of "Master List."

This all works really well, but now users have requested a couple of updates
that I'm not sure how to do:

1. Instead of just using Column B in both sheets as the column for
determining a match, users would prefer that the macro use the values in both
Columns B and C--that is, if the macro finds a row in "Master List" where the
values in B and C correspond to a row in "Weekly Update," then and only then
does it overwrite the row in "Master List." If both values don't match, the
macro would add the row from "Weekly Update" onto the bottom of "Master List."

2. The really tricky update is this: As it is, the macro just copies and
pastes over the affected ranges in "Master List." You can easily tell which
rows have been overwritten just by turning the fonts in "Weekly update to
some funky, easily spotted color--that way you can scroll down the "Master
List" (which can be thousands of rows long) and see what had just been
brought over from the "Weekly Update." Unfortunately, there's no way to know
exactly what values in the row have been updated by the macro. (For example,
if the value in Column F changes from "TENTATIVE" to "FIRM", you have no way
of knowing without comparing a before-and-after versions of the Master List,
which is rather a pain. Is there any way for the macro to, in addition to
copying-and-pasting the updating row from "Weekly Update," to actually
highlight in some way (through font or cell color) all cells in the row whose
values have changed? That at least would help target investigation if it were
needed. It would be REALLY cool if something like Excel's "Change History"
function could be replicated, something that would, in addition to updating
the "Master List," generate a report of the before-and-after versions of each
row affected, but probably that's a demented dream.

Anyway, thanks for your patience reading this and for any help you can
offer! Even if it's only to say, "none of this is possible," I'd really
appreciate any perspectives you have.

If it's useful, most users run this workbook on Excel 2004 for Mac, whose
closest analogue in PC world seems to be Excel 2003. (So far, the macro has
worked well on both platforms.)
 
J

Joel

See if this works. I made improvements to speed up the coded as well as the
changes you requested.

Sub Update()
Dim LastRow As Long
Dim NewRow As Long
Dim UL As Long
Dim ColB_Data
Dim ColC_Data

LastRow = Sheets("Master List").Range("B" & Rows.Count).End(xlUp).Row
NewRow = LastRow + 1

UL = 2 'UpdateList Start Row
Do Until Sheets("Weekly Update").Cells(UL, "B") = ""
ColB_Data = Sheets("Weekly Update").Cells(UL, "B")
ColC_Data = Sheets("Weekly Update").Cells(UL, "C")

With Sheets("Master List")
Found = False
Set c = .Columns("B").Find(what:=Data, _
LookIn:=xlValues, lookat:=xlWhole)
If Not c Is Nothing Then

FirstAddr = c.Address

Do
If c.Offset(0, 1) = ColC_Data Then
Worksheets("Weekly Update").Range(Cells(UL, "A"), Cells(UL,
"N")).Copy _
Destination:=.Cells(c.Row, "A")
.Range(Cells(c.Row, "A"), Cells(c.Row,
"N")).Interior.ColorIndex = 4
Found = True
Exit Do

End If

Set c = .Columns("B").FindNext(after:=c)
Loop While Not c Is Nothing And c.Address <> FirstAddr
End If

If Found = False Then
With Worksheets("Weekly Update")
.Range(Cells(UL, "A"), Cells(UL, "N")).Copy _
Destination:=Sheets("Master List").Cells(NewRow, "A")
.Range(Cells(NewRow, "A"), Cells(NewRow,
"N")).Interior.ColorIndex = 4
NewRow = NewRow + 1
End With
End If
End With
UL = UL + 1
Loop
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top