Excel VBA Deleting Rows of Dates - vba

Question

I have a column of dates in Column D in the mm-dd-yyyy format. Below is the code that I am trying to use to delete the entire row of data if the Active Cell in Column D is either Blank, Today's Date, or older than 8 days (i.e. today is 3/13/14, so it would erase blank entries, today's date, and anything older than 3/5/14).
Dim lastrow As Long
lastrow = Range("A65536").End(xlUp).Row
Range("D" & lastrow).Select
Do
If (ActiveCell = "" Or ActiveCell = Format(Now, "mm/dd/yyyy") Or ActiveCell < Format(Now -8, "mm/dd/yyyy")) _
Then ActiveCell.EntireRow.Delete
ActiveCell.Offset(-1, 0).Select
Loop Until ActiveCell = "Completed Date)"
If I use the "<" symbol, it erases everything basically, and if I use the ">" symbol, then it doesn't erase the rows with dates in February, etc. Can anyone suggest a method that will work, or why mine isn't?

Answer 1

I'm just thinking off the top of my head, but the moment you use the Format keyword in Excel, it probably converts the date to a text value, so you can't perform comparison operations on it...
Try this instead:
If (ActiveCell = "" Or (ActiveCell = Format(Now, "mm/dd/yyyy")) Or (Cdate(ActiveCell) < (Now -8))) _
In effect, rather than changing NOW()-8 to text, converting Activecell to a date you can use for comparison's sake.
Again, I didn't do this with VBA, but I'm guessing it should do the trick.
Good luck!!

Answer 2

Try use DateDiff:
If not isempty(activecell)
If DateDiff("d", Now(), ActiveCell.Value) < -8 then
'do your stuff
endif
endif

Answer 3

Paste the following code into a module:
Sub ScrubData()
Dim i As Long
Dim numRowsWithVal As Long
Dim myActiveCell As Range
Dim todaysDate As Date
Dim cutoffDate As Date
'Use a custom function to delete all blank rows in column specified
Call DeleteAllBlankRowsInColumn("D")
'Use VBA's Date() function to get current date (i.e. 3/13/14)
todaysDate = Date
'Set the cutoff date to anything older than 8 days
cutoffDate = todaysDate - 8
'***** Loop through all rows and clear values if rows are equal to today's date or older than 8 days ******
'Count the number of rows with values (subtract one because sheet has headers)
numRowsWithVal = (Range("D" & Rows.Count).End(xlUp).Row) - 1
'Start at Range("D2")
Set myActiveCell = ActiveSheet.Range("D2")
For i = 0 To numRowsWithVal - 1
Select Case True
'If value of cell is today's date OR older than 8 days clear the values
Case myActiveCell.Offset(i, 0).Value = todaysDate, myActiveCell.Offset(i, 0).Value <= cutoffDate
myActiveCell.Offset(i, 0).ClearContents
'Value is valid, do nothing
Case Else
End Select
Next
'***********************************************************************************************************
'Now that values are cleared, delete all blank rows again
Call DeleteAllBlankRowsInColumn("D")
End Sub
Public Function DeleteAllBlankRowsInColumn(ByVal columnLetter As String)
'Delete all blank rows in column specified (suppress errors just in case there aren't any blank cells)
On Error Resume Next
Columns(columnLetter).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'Set error handling back to normal
On Error GoTo 0
End Function
Before:
After: