[COLOR=darkblue]Option[/COLOR] [COLOR=darkblue]Explicit[/COLOR]
[COLOR=darkblue]Sub[/COLOR] KeepLastEntry()
[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]
[COLOR=darkblue]Dim[/COLOR] j [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
LastRow = Cells(Rows.Count, "C").End(xlUp).Row
[COLOR=darkblue]With[/COLOR] Range("C1:V" & LastRow)
.Sort _
key1:=.Cells(1), order1:=xlAscending, _
key2:=.Cells(1, 5), order2:=xlDescending, _
Header:=xlYes, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTop[COLOR=darkblue]To[/COLOR]Bottom
[COLOR=darkblue]For[/COLOR] i = LastRow [COLOR=darkblue]To[/COLOR] 2 [COLOR=darkblue]Step[/COLOR] -1
[COLOR=darkblue]If[/COLOR] WorksheetFunction.CountIf(Range(.Cells(2, 1), .Cells(i, 1)), .Cells(i, 1)) > 1 [COLOR=darkblue]Then[/COLOR]
[COLOR=darkblue]For[/COLOR] j = 8 To 20
[COLOR=darkblue]If[/COLOR] .Cells(i, j).Value > .Cells(i - 1, j).Value [COLOR=darkblue]Then[/COLOR]
.Cells(i - 1, j).Value = .Cells(i, j).Value
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
[COLOR=darkblue]Next[/COLOR] j
.Rows(i).Delete shift:=xlShiftUp
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
[COLOR=darkblue]Next[/COLOR] i
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]
MsgBox "Completed...", vbInformation
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]