Delete Duplicate rows with same cell value but.....

[DaveUK]

I am using this code to sort my list which works fine:

Sub RemoveDuplicates()

With Application
    .ScreenUpdating = False
    .Calculation = xlCalculationManual
    End With

With workbooks("Book1").Worksheets("Sheet1")

Range("A1:Q" & Range("C65536").End(xlUp).Row).Sort key1:=Range("G1"), order1:=xlAscending, key2:=Range("B1"), header:=xlYes


' ***********************************

' Need Delete Code here !!!

' ***********************************



Range("A2").Select

End With

With Application
    .ScreenUpdating = True
    .Calculation = xlCalculationAutomatic
    End With

End Sub

I need some code that will:

1, Check for duplicate cells in column C2 (as there is a header in row 1) and have a range going to the last nonempty cell in column C.

2, Delete duplicate rows BUT keep the last row as the data has been sorted by the end date and the last row containds the newest data.

Please advise.

TIA

 

[Oorang]

Dim LC As Long
Dim BR As Long
BR = Range("c65536").End(xlUp).Row
For LC = BR To 2 Step -1
If Application.WorksheetFunction.CountIf(Range("C2:C65536"), Range("C" & LC)) > 1 Then Rows(LC).Delete
Next LC