I created a macro that compares two ranges and updates the 'master' range with new records from a data refresh thanks to some great help from Justin Doward. I then took his code and 'reversed it' so I could identify records in the master list that no longer appear in the the new data range and flag them as 'dropped' on the master list. (I don't want to delete them from the master list)
If possible, I would like to combine these two macros. I would appreciate any help as well as comments on how I can clean up the code that I've no doubt sullied after Mr Doward provided it to me. There is also a bug in the Compare2 macro insofar as it copies the comment 'dropped' beside empty rows when the master list is much longer than the new list. I've attached a workbook with the macros as well as copied them below. forum.ozgrid.com/index.php?attachment/35764/
Sub compare1() 'compare new data(on 'from' sheet) to master list (on 'to' sheet)
Dim MyRnge, MyNewRnge As Variant
Dim MyCounter As Integer
'http://www.ozgrid.com/forum/showthread.php?t=149625 BY JUSTIN DOWARD
'Currently the macro compares each agent number in MyRnge to each number in MyNewRnge,
'if it finds a match it tacks details into the same row (I did not refine it to determine '
'whether the details are already the same) if it finds one not already existing it creates
'a new row. If you copy the existing nested loop and reverse the way the nesting is done
'(have each MyNewRnge compared to each MyRnge) and then have it act on a row identified as no
'longer being present that should do the job.
'MyRnge(1, 1) returns the first item in MyRnge
'Ubound(MyRnge, 1) returns the number of rows used in MyRnge
'Since I have started at row 1 it happen that in the loop i is
'almost the same as the row number of the item (i + 1) returns the row of the item in MyRnge for this loop
'HOW WOULD YOU CHANGE IT TO START AT ROW2?
'MyRnge=column 1 starting from row 2
MyRnge = Sheets("from").Range(Cells(2, 1).Address, Cells(Sheets("from").UsedRange.Rows.Count, _
Sheets("from").UsedRange.Columns.Count).Address) '= fresh data to be merged
'MyNewRnge=column 1 starting from row 2
MyNewRnge = ActiveWorkbook.Sheets("to").Range(Cells(2, 1).Address, Cells(Sheets("to").UsedRange.Rows.Count, _
Sheets("to").UsedRange.Columns.Count).Address) ' = master list
With Application
.Calculation = xlCalculationManual 'do not use if following events require calcs
.EnableEvents = False
.ScreenUpdating = False
'.DisplayAlerts = False 'ignores "Overwrite file?" type errors
End With
Sheets("to").Rows("1:1").HorizontalAlignment = xlCenter
Sheets("to").Range("A1") = "Lic#"
Sheets("to").Range("B1") = "Name"
Sheets("to").Range("C1") = "Agency"
Sheets("to").Range("D1") = "Status"
Sheets("to").Range("E1") = "As of:"
Sheets("to").Range("F1") = "AgencyNow"
For i = 1 To UBound(MyRnge, 1)
MyCounter = 0
For X = 1 To UBound(MyNewRnge, 1)
If MyNewRnge(X, 1) = MyRnge(i, 1) Then
'If Lic# matches, append agent+agency name to column D on 'to' sheet
Sheets("to").Range("A" & X).Offset(1, 5) = Sheets("from").Range("C" & i + 1) 'Lic+agency name
Sheets("to").Range("A" & X).Offset(1, 3) = "onlist" 'add comment to confirm it's already on masterlist
Sheets("to").Range("A" & X).Offset(1, 4) = Format(Date, "Mmmdd/yyyy")
'If agency name on 'to' page = agency name on 'from' page
If Sheets("to").Range("A" & X).Offset(1, 2) = Sheets("from").Range("C" & i + 1) Then
'MsgBox Sheets("to").Range("A" & X).Offset(1, 1) & Sheets("to").Range("A" & X).Offset(1, 2) & "=" & & Sheets("from").Range("C" & i + 1)
Else
' MsgBox "new agency"
Sheets("to").Range("A" & X).Offset(1, 3) = "switched" 'agent switched to new agency
Sheets("to").Range("A" & X).Offset(1, 4) = Format(Date, "Mmmdd/yyyy")
End If
MyCounter = MyCounter + 1
End If
Next X
'lic# did not match, so define "addrow"=1st empty row on "to" sheet
'and copy over the 3 values
If MyCounter = 0 Then '
addrow = Sheets("to").Range("a65536").End(xlUp).Row + 1
Sheets("to").Cells(addrow, 1) = MyRnge(i, 1) 'copy lic# to A
Sheets("to").Cells(addrow, 2) = MyRnge(i, 2) 'agent name to B
Sheets("to").Cells(addrow, 3) = MyRnge(i, 3) 'agency name to C
Sheets("to").Cells(addrow, 4) = "new to list" 'comment to D
Sheets("to").Cells(addrow, 5) = Format(Date, "Mmmdd/yyyy")
MyCounter = MyCounter + 1
Else
End If
Next i
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.ScreenUpdating = True
.DisplayAlerts = True
End With
End Sub
Display More
Sub compare2() 'compare master list to new data to see which agents dropped off
'to find agents no longer licensed i.e. appear in master list but not new list
Dim MyRnge, MyNewRnge As Variant
Dim MyCounter As Integer
MyRnge = Sheets("from").Range(Cells(2, 1).Address, Cells(Sheets("from").UsedRange.Rows.Count, _
Sheets("from").UsedRange.Columns.Count).Address) '= my master list
MyNewRnge = ActiveWorkbook.Sheets("to").Range(Cells(2, 1).Address, Cells(Sheets("to").UsedRange.Rows.Count, _
Sheets("to").UsedRange.Columns.Count).Address) ' = fresh data download from gov't site
For i = 1 To UBound(MyNewRnge, 1) '<changed from MyRnge
MyCounter = 0
For X = 1 To UBound(MyRnge, 1) '<changed from MyNewRnge
'if existing lic# is on MyRnge
If MyRnge(X, 1) = MyNewRnge(i, 1) Then '<was MyNewRnge(X, 1)= MyRnge(i, 1)
' If MyNewRnge(i, 1) = MyRnge(X, 1) Then '<was MyNewRnge(X, 1)= MyRnge(i, 1)
'so now if lic# from MyNewRnge is found in MyRnge add comment
'Sheets("to").Range("A" & X).Offset(1, 4) = "still on list"
MyCounter = MyCounter + 1
End If
Next X
If MyCounter = 0 Then
'lic# not in MyRnge therefore...add missing record lic3/name to bottom with note "dropped"
'addrow = Sheets("to").Range("a1048576").End(xlUp).Row + 1
'Sheets("to").Cells(addrow, 1) = MyNewRnge(i, 1)
'Sheets("to").Cells(addrow, 2) = MyNewRnge(i, 2)
'Sheets("to").Cells(addrow, 3) = MyNewRnge(i, 3)
'Sheets("to").Cells(addrow, 4) = "dropped"
'works
'Sheets("to").Range("A" & i).Offset(1, 5) = "dropped2"
Sheets("to").Range("A" & i).Offset(1, 3) = "dropped"
Sheets("to").Range("A" & i).Offset(1, 4) = Format(Date, "Mmmdd/yyyy")
MyCounter = MyCounter + 1
Else
End If
Next i
End Sub
Display More