Deleting Rows that contain future Dates

[jsully777]

Hi,

I am having troubles deleting rows that contain future dates. I want to keep rows that have today's date and previous dates but delete all rows that have tomorrow's date and beyond. When I use the code below, it deletes only a few rows at a time. I have to keep hitting the macro button to complete the deletion.

Anyone out there that could help?


Sub Delete()

'**************************************************************'
'Display Only Today's Dates and Previous Dates'
Sheets("R149").Select
iRow = 4
Do Until Sheets("R149").Cells(iRow, 6) = ""
If Sheets("R149").Cells(iRow, 6) > Date Then
Selection.EntireRow.Delete
'Sheets("R149").Rows(iRow).Delete 'Delete Future Dates
iRow = iRow + 1
Else
iRow = iRow + 1
End If
Loop

'**************************************************************'
End Sub


Any Thoughts?

Thx,
Jim

 

[Nimrod]

ASSUMPTION: Dates are in column 6 of the Activesheet :wink:

:-> VERSION 1
Public Sub DeleteTheFuture()
For Rw = Cells(65536, 6).End(xlUp).Row To 1 Step -1
With Cells(Rw, 6)
If IsDate(.Value) And .Value > Date Then .EntireRow.Delete
End With
Next Rw
End Sub



OOORRRR.... This version allows you to work on any sheet ...even if not active

:-> VERSION 2
Public Sub SheetToWorkOn()
Call DeleteTheFutureV3("R149")
End Sub

Private Sub DeleteTheFutureV3(ShName)
With Sheets(ShName)
For Rw = .Cells(65536, 6).End(xlUp).Row To 1 Step -1
With .Cells(Rw, 6)
If IsDate(.Value) And .Value > Date Then .EntireRow.Delete
End With
Next Rw
End With
End Sub

 

[jsully777]

Didn't work

Nimrod,

My appologies... I accidently hit the "report" button... on your reply. Very Very sorry. After reading van pookie's annoucements, I feel bad.

I tried your suggestion using a macro button and I stumped....

Here is my code:

Sub Reorg_Data()

'************************************************************'
With Sheets("R149")
For Rw = .Cells(65536, 6).End(xlUp).Row To 1 Step -1
With .Cells(Rw, 6)
If IsDate(.Value) And .Value > Date Then .EntireRow.Delete
End With
Next Rw
End With


It gets stuck on "If IsDate(.Value) And .Value > Date "

BTW, greetings from the North Shore
Jim

 

[Nimrod]

Try it this way then...

Public Sub DeleteTheFuture()
With Sheets("R149")
For Rw = .Cells(65536, 6).End(xlUp).Row To 1 Step -1
With .Cells(Rw, 6)
If IsDate(.Value) Then
If .Value > Date Then .EntireRow.Delete
End If
End With
Next Rw
End With
End Sub

 

[jsully777]

SSSWWWEEEETTTT

Thank you. It worked perfectly.

I'm new to Macros and VBA, so just want to say that your help is greatly appreciated....

Thx,
Jim
North Vancouver,
Mfg Eng.

 

[Nimrod]

Your very welcome ... it's always a pleasure to help those that appreciate the assistance. :wink: