Delete all rows not current date

[SITCFanTN]

The date in my table is in mm/dd/yy format and located in column E. I need
to delete all rows not the current date quickly. I want to build a macro in
VB to delete all records not the current date. Any help you have is greatly
appreciated, thank you.

 

[Rick Rothstein]

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

 

[Paul C]

Sub deletedates()

lastrow = Range("e10000").End(xlUp).Row
For A = 1 To lastrow
If Cells(A, 5) <> Today Then Cells(A, 5).EntireRow.delete
Next A

End Sub

 

[Paul C]

Sorry - You should work from the bottom to not get caught in a bad loop

Sub deletedates()

lastrow = Range("e10000").End(xlUp).Row
For A = lastrow To 1 Step -1
If Cells(A, 5) <> Today Then Cells(A, 5).EntireRow.delete
Next A

End Sub

 

[SITCFanTN]

HI Rick,

This deleted all my records, it didn't just delete the records that were not
dated for today. I only changed my sheet name...I changed your text of
"sheet 7" to "All Records"

Help, thank you.

 

[Rick Rothstein]

The code was tested before I posted it and it worked fine. The only reason,
off the top of my head, that I can think of why it didn't work for you is
that your "dates" are not really Excel dates, rather, I think your dates
might be text representation of dates instead.

 

[SITCFanTN]

That was it, once I converted to date format, this worked like a charm.
Thanks so much Rick!