[COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR]
[COLOR=darkblue]Sub[/COLOR] KeepLastTwoEntries()
[COLOR=darkblue]Dim[/COLOR] LastRow [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
[COLOR=darkblue]Dim[/COLOR] LastCol [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
[COLOR=darkblue]Dim[/COLOR] i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
[COLOR=darkblue]With[/COLOR] ActiveSheet
[COLOR=darkblue]If[/COLOR] .FilterMode [COLOR=darkblue]Then[/COLOR] .ShowAllData
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
LastCol = Cells(1, Columns.Count).End(xlToLeft).Column
[COLOR=darkblue]With[/COLOR] Range(Cells(2, LastCol + 1), Cells(LastRow, LastCol + 1))
.FormulaR1C1 = "=ROW()"
.Value = .Value
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
Range("A1", Cells(LastRow, LastCol + 1)).Sort _
key1:=Range("A1"), order1:=xlAscending, _
key2:=Range("C1"), order2:=xlDescending, _
Header:=xlYes, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
[COLOR=darkblue]With[/COLOR] Cells(2, LastCol + 2)
.FormulaArray = "=IF(COUNTIF($A$2:A2,A2)=1,""x"",IF(ROWS($A$2:A2)=MATCH(1,IF($A$2:A2=A2,IF($C$2:C2<>INDEX($C$2:C2,MATCH(A2,$A$2:A2,0)),1)),0),""x"",""""))"
.Copy Range(Cells(3, LastCol + 2), Cells(LastRow, LastCol + 2))
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
[COLOR=darkblue]With[/COLOR] Range("A1", Cells(LastRow, LastCol + 2))
.AutoFilter field:=LastCol + 2, Criteria1:="<>x"
.Offset(1, 0).EntireRow.Delete
.AutoFilter
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
Range("A1", Cells(LastRow, LastCol + 2)).Sort _
key1:=Cells(1, LastCol + 1), order1:=xlAscending, _
Header:=xlYes, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
Columns(LastCol + 1).Resize(, 2).ClearContents
Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
MsgBox "Completed...", vbInformation
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]