Give the following macro a try; change my example setup in the three Const
statements to match your actual layout. Note that I interpreted your
reference to "current date" to be today's date; if that was wrong, then
change the <>Date condition in the first If statement to the date value you
actually want to use.
Sub RemoveNotCurrentRecords()
Dim X As Long
Dim LastRow As Long
Dim OriginalCalculationMode As Long
Dim RowsToDelete As Range
Const DataStartRow As Long = 1
Const UnionColumn As String = "E"
Const SheetName As String = "Sheet7"
On Error GoTo Whoops
OriginalCalculationMode = Application.Calculation
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
With Worksheets(SheetName)
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
For X = LastRow To DataStartRow Step -1
If .Cells(X, UnionColumn).Value <> Date Then
If RowsToDelete Is Nothing Then
Set RowsToDelete = .Cells(X, UnionColumn)
Else
Set RowsToDelete = Union(RowsToDelete, .Cells(X, UnionColumn))
End If
If RowsToDelete.Areas.Count > 100 Then
RowsToDelete.EntireRow.Delete xlShiftUp
Set RowsToDelete = Nothing
End If
End If
Next
End With
If Not RowsToDelete Is Nothing Then
RowsToDelete.EntireRow.Delete xlShiftUp
End If
Whoops:
Application.Calculation = OriginalCalculationMode
Application.ScreenUpdating = True
End Sub
