Delete Duplicates based on Earliest or Latest Time

Sub DeleteData()
Const FORMULA_DELETE As String = _
    "=OR($D3=MIN(IF(($A$3:$A$<lastrow>=A3)*($E$3:$E$<lastrow>=""In""),$D$3:$D$<lastrow>))," & _
        "$D3=MAX(IF(($A$3:$A$<lastrow>=A3)*($E$3:$E$<lastrow>=""Out""),$D$3:$D$<lastrow>)))"
Dim rng As Range
Dim lastrow As Long
Dim i As Long


    With ActiveSheet
    
        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        .Columns("I").Insert
        .Rows(1).Insert
        .Range("I1:I2").Value = Array("tmp", "TRUE")
        .Range("I3").FormulaArray = Replace(FORMULA_DELETE, "<lastrow>", lastrow + 1)
        .Range("I3").AutoFill .Range("I3").Resize(lastrow - 1)
        Set rng = .Range("I1").Resize(lastrow)
        rng.AutoFilter 1, "=FALSE"
        On Error Resume Next
        Set rng = rng.SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        If Not rng Is Nothing Then
        
            rng.EntireRow.Delete
        End If
        .Columns("I").Delete
    End With
End Sub