Delete row after 120 days

[AC]

I have a date in column C, I want to delete the whole row when this date is 120 days old based on the current day,=Now(). Can this be done? Thanks I am using Excel '97

[ This Message was edited by: ac on 2002-03-22 12:19 ]

[Mark W.]

Apply an Advanced AutoFilter with a Criteria range containing the formula, =TODAY()-'Date'>=120. Delete the displayed records. For more on the specification of criteria see the Excel Help topic for "Examples of advanced filter criteria".

[ This Message was edited by: Mark W. on 2002-03-22 12:36 ]

[Mudface]

Right-click on your sheet tab, select view code and paste in the code below. This assumes your date is in cell C1 and will be run whenever you change something on the sheet (although it can be modified to run when the workbook is opened, the sheet is activated etc etc.): -

Private Sub Worksheet_Change(ByVal Target As Range)

If DateDiff("d", [c1].Value, Now) >= 120 And [c1].Value <> "" _
Then [c1].EntireRow.Delete shift:=xlUp

End Sub

[AC]

MudFace, I like your approach it works for C1, I want to delete the rows for all the dates in column C from C3:C4000, Can this be done?

[Mudface]

The following should work OK, though I'm sure there's a better way: -

In the VBA editor, insert a module and then copy and paste the following code: -

Public Sub DeleteRows()

Dim rw As Integer
Dim x As Integer

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual

rw = Range("C65536").End(xlUp).Row

For x = rw To 3 Step -1
If DateDiff("d", Range("c" & x).Value, Now) >= 120 And Range("c" & x).Value <> "" _
Then Rows(x).EntireRow.Delete shift:=xlUp
Next x
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

End Sub

[Tom Schreiner]

[ This Message was edited by: TsTom on 2002-03-22 18:18 ]

[Tom Schreiner]

Mudface
Will probably give a type-mismatch error if an invalid date is entered?

[Mudface]

Sorry, Tom, that won't work properly, it will only delete every other row (try filling in 4000 rows from 1/1/2000 onwards to see). You need to go backwards with this sort of thing. Also, your message will pop up every time a row is deleted, unless you remove it from inside the loop.

Ooops, right about the type-mismatch error, try this instead: -

Public Sub DeleteRows()

Dim rw As Integer
Dim x As Integer

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual

rw = Range("C65536").End(xlUp).Row

For x = rw To 3 Step -1
If IsDate(Range("c" & x).Value) Then
If DateDiff("d", Range("c" & x).Value, Now) >= 120 And Range("c" & x).Value <> "" _
Then Rows(x).EntireRow.Delete shift:=xlUp
End If
Next x
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With

End Sub

[ This Message was edited by: Mudface on 2002-03-22 13:41 ]

[AC]

Thanks everybody, that works, I am using yours MudFace

[C. O. Jones]

Here's more efficient code (avoids using a loop) :-

Dim rng As Range
Set rng = Range([C1], [C65536].End(xlUp))
Application.ScreenUpdating = False
rng.EntireColumn.Insert
With rng.Offset(0, -1)
.FormulaR1C1 = "=IF(RC[1]+120<=NOW(),1,"""")"
On Error Resume Next
.SpecialCells(xlCellTypeFormulas, 1).EntireRow.Delete
On Error GoTo 0
.EntireColumn.Delete
End With


[ This Message was edited by: C. O. Jones on 2002-03-22 18:07 ]