Try this -

It will highlight all of the rows except the rows with the latest date in, you can then simply do Edit Delete. 

Sub cleanData()
'first get the extent of the data

Dim rng As Range, rng1 As Range
Dim s1 As String, s2 As String
Dim dteMax As Date, s3 As String
Dim cell As Range
With ActiveSheet
 Set rng = .Range(.Cells(5, "B"), _
  .Cells(Rows.Count, "B").End(xlUp))
End With
s1 = rng.Address
s2 = rng.Offset(0, 3).Address
For Each cell In rng
s3 = s1 & "=" & cell.Address & "," & _
       s2 & "))"
dteMax = Evaluate("MAX(IF(" & s3)
If cell.Offset(0, 3).Value <> dteMax Then
   If rng1 Is Nothing Then
     Set rng1 = cell
   Else
     Set rng1 = Union(rng1, cell)
   End If
 End If
Next
If Not rng1 Is Nothing Then
 rng1.EntireRow.Select
End If
End Sub