Sub titi()
Dim DL&, x
DL = Cells(Rows.Count, 1).End(3).Row
x = Application.Max(Columns(4))
Cells(2, Columns.Count).Resize(DL - 1).Formula = _
"=IF(AND(A2=$A$1,D2<" & x & "),""$"",1)"
Application.ScreenUpdating = False
On Error Resume Next
Columns(Columns.Count).SpecialCells(-4123, 2).EntireRow.Delete
End Sub