Excel VBA - delete duplicates and keep the latest (based on date column)

Question

Can somebody help me? I don't even know how to start... I want to make a macro that deletes duplicates (based on column A) and keep the row that has the latest Date (column P). And if all duplicates have no date in column P, just keep one and delete the other duplicates.

The Data in the sheet starts with row 5 (not row 4 like in the picture, sorry for that). In the past I know that I had problems with deleting duplicates via macro when the table don't start with row 1 or 2.

The table normally has around ~15 columns and ~10.000 rows.

Some of the rows have date in column P and some row don't. So the macro should look if there are any duplicates (column A) and if so, check if there is a date in column P. If there are more duplicates with dates, the macro should delete all duplicates but keep the most recent.

The Code I used/edited so far:

Sub DelDubs_Date()

Dim Rng As Range
Dim LastRow As Long
Dim i As Long

Application.ScreenUpdating = False

LastRow = Cells(Rows.Count, "B").End(xlUp).Row

Set Rng = Range("A5:P" & LastRow)

With Rng
    .Sort key1:=Range("A5"), order1:=xlAscending, key2:=Range("P5"), order2:=xlDescending, _
        Header:=xlYes, OrderCustom:=1, MatchCase:=False, _
        Orientation:=xlTopToBottom
End With

For i = LastRow To 2 Step -1
    If WorksheetFunction.CountIf(Range(Cells(2, "A"), Cells(i, "A")), Cells(i, "A")) > 1 Then
        Rows(i).Delete
    End If
Next i

Application.ScreenUpdating = True

End Sub

Problem: it keeps the first row, not the one with the latest date...

TL;DR: Check for Duplicates in A, then check for dates in P, then delete all duplicates but keep the latest. And if there is no date, delete all duplicates and keep one.

Answer 1

Since I faced the removing duplicates bug described here and here -faced in office 2013, the threads relate to 2010 and I won't expect they fixed it in 2016 one-. I don't rely in this function ever, instead, I coded this:

Sub TryMe()
    Call RealRemoveDuplicates("MySheet", Range("A1:C5"))
End Sub
Sub RealRemoveDuplicates(InSheet As String, InRange As Range)
    Call CreateSheets("DummyDuplicate")
    Sheets(InSheet).Range(InRange.Address(False, False)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range( _
            "A1"), Unique:=True
    Sheets(InSheet).Range(InRange.Address(False, False)).Clear
    ActiveSheet.UsedRange.Copy Destination:=Sheets(InSheet).Range(InRange.Address(1))
    Sheets("DummyDuplicate").Delete
End Sub
Sub CreateSheets(NameSheet As String, Optional Looked_Workbook As Workbook)
Dim SheetExists As Worksheet
    If Looked_Workbook Is Nothing Then Set Looked_Workbook = ThisWorkbook '1.  If Looked_Workbook Is Nothing
    On Error GoTo ExpectedErr01CreateSheets
    Set SheetExists = Looked_Workbook.Worksheets(NameSheet)
    SheetExists.Delete
    If Err.Number <> 0 Then '2.  If Err.Number <> 0
ExpectedErr01CreateSheets:         'this means sheet didn't existed so, we are going to create it
    End If '2.  If Err.Number <> 0
        With Looked_Workbook
        .Sheets.Add After:=.Sheets(.Sheets.Count)
        ActiveSheet.Name = NameSheet
        End With
End Sub

Answer 2

Convert the dates from text to dates and you can record a macro of this:
1. Sort by Conf. Date from newest to oldest
2. Data > Remove Duplicates > uncheck all but the REF column
3. Sort by the REF column

---

I think this would be easier and more flexible wit PivotTable or PowerPivot.

Answer 3

Normally I would just throw all this into one Sub but you seemed to like @John Bustos solution. I tested this once and it seemed to work let me know if I missed anything.

Option Explicit
Dim wbk As Workbook
Dim ws As Worksheet
Dim lRow As Long
Sub CallSubs()
    Call FormatDates
    Call SortSmall
    Call RemoveDups
End Sub
Sub FormatDates()

Set wbk = Workbooks("Book1.xlsm")
Set ws = wbk.Worksheets("Sheet1")

With ws
    'Find last row
    lRow = .Cells.Find(What:="*", _
        After:=.Cells(1, 1), _
        LookIn:=xlFormulas, _
        LookAt:=xlPart, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False).Row
    'This will only work if Columns B through O have data
    'Turn on Autofilter
    If .AutoFilterMode = False Then
        .Cells(3, 1).AutoFilter
    End If
    .Range("P4:P" & lRow).Replace What:=".", Replacement:="/", LookAt:=xlPart, MatchCase:=False
    .Range("P4:P" & lRow).NumberFormat = "dd/mm/yyyy;@"
End With
End Sub

Sub SortSmall()

Set wbk = Workbooks("Book1.xlsm")
Set ws = wbk.Worksheets("Sheet1")

With ws
    lRow = .Cells.Find(What:="*", _
        After:=.Cells(1, 1), _
        LookIn:=xlFormulas, _
        LookAt:=xlPart, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False).Row
    'I used the macro recorder for this and cleaned it up let me know if there is a better way
    'Sort Dates Z To A
    .AutoFilter.Sort.SortFields.Clear
    .AutoFilter.Sort.SortFields.add Key:=.Range("P3:P" & lRow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
    With .AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End With
End Sub
Sub RemoveDups()
Set wbk = Workbooks("Book1.xlsm")
Set ws = wbk.Worksheets("Sheet1")

With ws
    lRow = .Cells.Find(What:="*", _
        After:=.Cells(1, 1), _
        LookIn:=xlFormulas, _
        LookAt:=xlPart, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False).Row
    .Range("A3:P" & lRow).RemoveDuplicates Columns:=1, Header:=xlYes
End With
End Sub