Option Explicit
Sub exa()
Dim _
wksOld As Worksheet, _
wksNew As Worksheet, _
wksDiscontinued As Worksheet, _
wksUpdated As Worksheet, _
rngLRow As Range, _
rngOldSheet As Range, _
rngNewSheet As Range, _
rngRecord As Range, _
rCell As Range
With ThisWorkbook
'// Change sheetnames to match actual //
Set wksOld = .Worksheets("Sheet1")
Set wksNew = .Worksheets("Sheet2")
'// Find last record in old sheet. //
Set rngLRow = wksOld.Range("A:A").Find(What:="*", _
After:=wksOld.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
'// Bail if nothing found... //
If rngLRow Is Nothing Then Exit Sub
'// Set a reference to the range we need to look from. //
Set rngOldSheet = Range(wksOld.Range("A2"), rngLRow)
'// SAA//
Set rngLRow = wksNew.Range("A:A").Find(What:="*", _
After:=wksNew.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If rngLRow Is Nothing Then Exit Sub
Set rngNewSheet = Range(wksNew.Range("A2"), rngLRow)
'// Set references to added sheets. //
Set wksDiscontinued = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count), _
Type:=xlWorksheet)
Set wksUpdated = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count), _
Type:=xlWorksheet)
End With
wksDiscontinued.Name = "Discontinued"
wksUpdated.Name = "Updated"
'// Header labels for new sheets. //
wksDiscontinued.Range("A1:U1").Value = wksOld.Range("A1:U1").Value
wksUpdated.Range("A1:U1").Value = wksOld.Range("A1:U1").Value
'// for each record in old sheet... //
For Each rCell In rngOldSheet
'// ...see if there's a matching record in new sheet; ... //
Set rngRecord = rngNewSheet.Find(What:=rCell.Value, _
After:=rngNewSheet(1, 1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext)
'// ...then if not, add this record to discontinued sjeet. //
If rngRecord Is Nothing Then
wksDiscontinued.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 21).Value _
= rCell.Resize(, 21).Value
Else
'// If there was a matching record, I think we can skip checking for a price//
'// difference - maybe just take the latest price instead? //
wksUpdated.Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 21).Value _
= rngRecord.Resize(, 21).Value
'// Now, we'll delete the record from the newer sheet. This way, any records//
'// left on the new sheet, should be new - that is, they didn't exist on the//
'// old sheet. //
Application.DisplayAlerts = False
rngRecord.EntireRow.Delete
Application.DisplayAlerts = True
End If
Next
Set rngLRow = wksNew.Range("A:A").Find(What:="*", _
After:=wksNew.Cells(1, 1), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
'// If we had records (new ones) left on the new sheet, add these to the updated //
'// sheet. //
If Not rngLRow Is Nothing Then
Set rngNewSheet = Range(wksNew.Range("A2"), rngLRow).Resize(, 21)
rngNewSheet.Copy Destination:=wksUpdated.Cells(Rows.Count, 1).End(xlUp).Offset(1)
End If
'// pretty up the added sheets... //
wksDiscontinued.Columns.AutoFit
wksUpdated.Columns.AutoFit
End Sub
Hope that helps,