Solved: Resolved: Delete row after 3 months

[bonesmcgraw]

Lets say I have a date in column I. Is there a way to automatically delete the row after 3 months when the worksheet is opened or changed?

So if the date in column I is 1/1/2008 then on 4/1/2008 the row with that date would automatically delete. I would need this to go through every row which could be a few hundred rows long.

Anybody have any ideas on how to do this?

Thanks

[Ago]

i think you could use the date variable to do that.

[vba]

if Date - Range(cell).value > 90 then
Selection.EntireRow.Delete
end if

[/vba]

and make that as a makro to search the cells

but we need to know more information about your sheet, where is the date for example?
could you upload a dummy sheet that looks the same?

[tstav]

automatically delete the row after 3 months when the worksheet is opened or changed

Put this code in the Worksheet's Module:

[vba]Private Sub Worksheet_Activate()
Dim lastRow As Long, curRow As Long
lastRow = Range("I" & Rows.Count).End(xlUp).Row
For curRow = lastRow To 1 Step -1
If DateDiff("m", Range("I" & curRow).Value, Date) = 3 And _
Day(Date) = Day(Range("I" & curRow).Value) Then
Rows(curRow).Delete
End If
Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastRow As Long, curRow As Long
lastRow = Range("I" & Rows.Count).End(xlUp).Row
For curRow = lastRow To 1 Step -1
If DateDiff("m", Range("I" & curRow).Value, Date) = 3 And _
Day(Date) = Day(Range("I" & curRow).Value) Then
Rows(curRow).Delete
End If
Next
End Sub
[/vba]

But if you meant 3 days and not 3 months, change the "DateDiff" line of code to:
[vba]If DateDiff("d", Range("I" & curRow).Value, Date) = 3 Then[/vba]

[Bob Phillips]

Problem with Datediff is that it counts months inclusively, so 12th Jan to 1st April counts as 3, but by my reckoning 3 months are not yet up.

[tstav]

That's why I included the additional check with the Day() function.

[Bob Phillips]

But you don't need to

[vba]

With Range("I" & curRow)

If DateSerial(Year(.Value), Month(.Value) + 3, Day(.Value)) <= Date Then
Rows(curRow).Delete
End If
End With
[/vba]

[tstav]

The problem would be with Nov. 30th.
There is no Feb.30, so Nov.30 would never be deleted.
In that case I might use
[vba]If DateDiff("m", Range("I" & curRow).Value, Date) > 3 Or _
(DateDiff("m", Range("I" & curRow).Value, Date) = 3 And _
Day(Date) = Day(Range("I" & curRow).Value)) Then [/vba]

[Bob Phillips]

But it would get tidied up on 1st March (or any time after) because of the <= test.

And of course, your code won't tidy up any old ones that may get missed over weekends say.

[tstav]

I sent post #7 before seeing #6.
Yes. DateSerial is a much better choice indeed!

[Bob Phillips]

Not much better, just an alternative. I have been burnt by Datediff, so I tend to avoid it. As you point out, there is a flaw in just adding months when the month being added to has more days than the month target and the date is at the end of that month. Then you just manage it according to the requirement, for instance this will return 1st March when adding 3 to 30th Nov as you know

[vba]

Dim mpDate As Date

mpDate = DateSerial(2007, 11, 30)

MsgBox DateSerial(Year(mpDate), Month(mpDate) + 3, Day(mpDate))
[/vba]

whereas this will return 29th Feb

[vba]

Dim mpDate As Date

mpDate = DateSerial(2007, 11, 30)

MsgBox Format(ActiveSheet.Evaluate("MIN(DATE(YEAR(" & CLng(mpDate) & ")," & _
"MONTH(" & CLng(mpDate) & ")+{4,3}," & _
"DAY(" & CLng(mpDate) & ")*{0,1}))"), "dd mmm yyyy")
[/vba]

[sassora]

The question we should ask is whether it needs to be 3 months or is 90 days just as good. As was said, months weren't all created equal! Perhaps we could be thinking much more simplistically about this problem.

[tstav]

.

[tstav]

Here are some dates and what you get if you move forward
-3 months with DateSerial, or
-90 days simply by adding days.

Doesn't the DateSerial column depict better what we commonly mean when we say "3 months later"?

DateSerial (+3 months) (+90 days)
01/02/2007 01/05/2007 02/05/2007 (?)
30/01/2007 30/04/2007 30/04/2007
01/02/2007 01/05/2007 02/05/2007 (?)
28/02/2007 28/05/2007 29/05/2007 (?)
01/05/2007 01/08/2007 30/07/2007 (?)
30/05/2007 30/08/2007 28/08/2007 (???)
31/05/2007 31/08/2007 29/08/2007 (???)
01/11/2007 01/02/2008 30/01/2008 (?)
29/11/2007 29/02/2008 27/02/2008 (?)
30/11/2007 01/03/2008 28/02/2008 (???)

[sassora]

I agree it is good at giving a better representation of what we mean by "in three months time" but programmatically 90 days is easier and it may be of no difference to the person using it whether it was 90 days, 93 days or "3 months"

[Bob Phillips]

IMO, 90 days is the worst option. There is no 3 month span in a year that is 90 day, the best you can do is 91, and in that can still be 2 days out. So that level of inaccuracy is not even worth considering as other solutions are realtively simple to code.

[bonesmcgraw]

Thanks for all the help.

This is the code that I used and it's giving me an error.

[VBA]Private Sub Worksheet_Activate()
Dim lastRow As Long, curRow As Long
lastRow = Range("I" & Rows.Count).End(xlUp).Row
For curRow = lastRow To 1 Step -1
With Range("I" & curRow)

If DateSerial(Year(.Value), Month(.Value) + 3, Day(.Value)) <= Date Then
Rows(curRow).Delete
End If
End With
Next
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastRow As Long, curRow As Long
lastRow = Range("I" & Rows.Count).End(xlUp).Row
For curRow = lastRow To 1 Step -1
With Range("I" & curRow)

If DateSerial(Year(.Value), Month(.Value) + 3, Day(.Value)) <= Date Then
Rows(curRow).Delete
End If
End With
Next
End Sub
[/VBA]

The code deletes the correct rows but it gives me a run time error 13 type mismatch. Then I click the debug button and it highlights this line

[VBA]If DateSerial(Year(.Value), Month(.Value) + 3, Day(.Value)) <= Date Then[/VBA]

Any ideas on how to fix this?

Thanks

[rbrhodes]

Hi bones,

I can't recreate your error but... Everytime a row is deleted by these subs the sub fires again recursively. So you need to disable events temporarily as follows. May cure the problem...


[vba]
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim curRow As Long
Dim lastRow As Long

'Handle any errors
On Error GoTo endo

'Disable events so this sub doesn't run for EVERY deleted row
Application.EnableEvents = False

lastRow = Range("I" & Rows.Count).End(xlUp).Row

For curRow = lastRow To 1 Step -1
With Range("I" & curRow)
If DateSerial(Year(.Value), Month(.Value) + 3, Day(.Value)) <= Date Then
Rows(curRow).Delete
End If
End With
Next

'Error label
endo:

'reset
Application.EnableEvents = True

End Sub
[/vba]

[bonesmcgraw]

Thanks for the help it seems to be working.

[tstav]

I guess it encountered a cell that it cannot convert to a date in order for the DateSerial to work.
We will use Error Handling for this.
Apart from that we will also take care of possible blank cells and events from recurring

Change the code to this:
[vba]Private Sub Worksheet_Activate()
Dim lastRow As Long, curRow As Long
Application.EnableEvents = False
lastRow = Range("I" & Rows.Count).End(xlUp).Row
On Error Resume Next
For curRow = lastRow To 1 Step -1
With Range("I" & curRow)
If IsDate(.Value) And _
DateSerial(Year(.Value), Month(.Value) + 3, Day(.Value)) <= Date Then
If Err Then
Err.Clear
Else
Rows(curRow).Delete
End If
End If
End With
Next
Application.EnableEvents = True
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Dim lastRow As Long, curRow As Long
Application.EnableEvents = False
lastRow = Range("I" & Rows.Count).End(xlUp).Row
On Error Resume Next
For curRow = lastRow To 1 Step -1
With Range("I" & curRow)
If IsDate(.Value) And _
DateSerial(Year(.Value), Month(.Value) + 3, Day(.Value)) <= Date Then
If Err Then
Err.Clear
Else
Rows(curRow).Delete
End If
End If
End With
Next
Application.EnableEvents = True
End Sub
[/vba]

hmmm... rbrhodes already caught the events recurring thing...

[tstav]

The error handling in post #17 will stop the code from running possibly leaving rows unchecked for deletion.
This will not happen with code #19.