Macro required to delete rows based on date

Hi

See how this goes.

Sub aaa()
  Dim nodupes As New Collection
  For Each ce In Range("D2:D" & Cells(Rows.Count, "D").End(xlUp).Row)
    On Error Resume Next
    nodupes.Add Item:=ce.Value, key:=CStr(ce.Value)
    On Error GoTo 0
  Next ce

  For i = 1 To nodupes.Count
    lastrow = Cells(Rows.Count, "D").End(xlUp).Row
    maxdate = Evaluate("=MAX(IF(D2:D" & lastrow & "=" & nodupes(i) & ",R2:R" & lastrow & ",""""))")
    For j = lastrow To 2 Step -1
      If Cells(j, "D") = nodupes(i) And Cells(j, "R") <> maxdate Then
        Cells(j, "D").EntireRow.Delete
      End If
    Next j
    
  Next i
End Sub

rylo