Find earliest data by date

Sub DelDups()
Dim LR As Long, i As Long
LR = Range("A" & Rows.Count).End(xlUp).Row
For i = LR To 3 Step -1
    If WorksheetFunction.CountIf(Columns("A"), Range("A" & i).Value) > 1 Then Rows(i).Delete
Next i
End Sub

Option Explicit
    
Sub exa()
Dim DIC         As Object   '<---Dictionary
Dim lLRow       As Long
Dim rngVals     As Range
Dim Cell        As Range
Dim aryVals     As Variant
Dim i           As Long
Dim ii          As Long
Dim wks         As Worksheet
    
    Set DIC = CreateObject("Scripting.Dictionary")
    '// Change to suit or better, use sheet's codename  //
    Set wks = ThisWorkbook.Worksheets("Sheet1")
    
    '// Set a reference to Plan Names, assumes one header row and data starting at row 2//
    With wks
        Set rngVals = Range(.Cells(2, 1), .Cells(.Rows.Count, 1).End(xlUp))
    End With
    
    '// Plunk the vals into an array    //
    aryVals = rngVals.Value
        
    '// Get a collection of unique plans    //
    For i = 1 To UBound(aryVals, 1)
        DIC.Item(Trim(aryVals(i, 1))) = Empty
    Next
    
    '// Plunk them into an array (the array will now be one-dimensional)//
    aryVals = DIC.Keys
    
    For i = LBound(aryVals) To UBound(aryVals)
        '// Clear keys  //
        DIC.RemoveAll
        
        '// run thru the range, and add dates for the specific plan//
        For Each Cell In rngVals
            If Trim(Cell.Value) = aryVals(i) Then
                DIC.Item(Cell.Offset(, 1).Value2) = Empty
            End If
        Next
        
        '// Find the latest last row, as this will change as we loop//
        lLRow = wks.Cells(wks.Rows.Count, 1).End(xlUp).Row
        
        '// run UP the range... //
        For ii = lLRow To 2 Step -1
            '// ...if the cell has the plan we're looking for...    //
            If Trim(wks.Cells(ii, 1).Value2) = aryVals(i) Then
                '// if the date next to it isn;t the minimum date we have in the current//
                '// .Keys, delete the row                                               //
                If Not wks.Cells(ii, 2).Value2 = Application.Min(DIC.Keys) Then
                    wks.Rows(ii).Delete
                End If
            End If
        Next
    '// loop for ea plan//
    Next
End Sub