Date Calculation

[patsyshaw]

Is there a way that I can put a date in a cell, add 1 year and have the row
deleted automatically? We do background checks on people, add them to a list
but these checks are only good for one year. This would eliminate having to
go into the sheet and deleting the ones that are 1 year old.

Thanks.

 

[Eduardo]

Hi,
Let's say you have the date in column A in column B you add 365 days with

=A2+365

In column C you enter the formula as follow

=+IF(B2=TODAY(),"Y","N") If today's day is the same as in column B it will
enter "Y"

Then have a buttom to run a macro that will delete all the rows where column
C = "Y" as follow

Sub delete_Me()
Dim copyrange As Range
Lastrow = Cells(Cells.Rows.Count, "C").End(xlUp).Row
Set MyRange = Range("C1:C" & Lastrow)
For Each c In MyRange
If InStr(c, "Y") Then
If copyrange Is Nothing Then
Set copyrange = c.EntireRow
Else
Set copyrange = Union(copyrange, c.EntireRow)
End If
End If
Next
If Not copyrange Is Nothing Then
copyrange.Delete
End If
End Sub

Hope this help

 

[Gord Dibben]

Formulas cannot delete things.

You would need VBA to delete rows where the date was more than 1 year old.

This event code will delete those dates whenever the workbook is opened.

Private Sub Workbook_Open()
Sheets("Sheet1").Activate 'adjust sheetname
Dim RowNdx As Long
Dim LastRow As Long
Application.ScreenUpdating = False
LastRow = ActiveSheet.UsedRange.Rows.Count
For RowNdx = LastRow To 1 Step -1
If Cells(RowNdx, "A").Value < Date - 365 Then 'adjust column
Rows(RowNdx).Delete
End If
Next RowNdx
Application.ScreenUpdating = True
End Sub


Gord Dibben MS Excel MVP

 

[patsyshaw]

Thank you so much!!!
--
Patsy

Hi,
Let's say you have the date in column A in column B you add 365 days with

=A2+365

In column C you enter the formula as follow

=+IF(B2=TODAY(),"Y","N") If today's day is the same as in column B it will
enter "Y"

Then have a buttom to run a macro that will delete all the rows where column
C = "Y" as follow

Sub delete_Me()
Dim copyrange As Range
Lastrow = Cells(Cells.Rows.Count, "C").End(xlUp).Row
Set MyRange = Range("C1:C" & Lastrow)
For Each c In MyRange
If InStr(c, "Y") Then
If copyrange Is Nothing Then
Set copyrange = c.EntireRow
Else
Set copyrange = Union(copyrange, c.EntireRow)
End If
End If
Next
If Not copyrange Is Nothing Then
copyrange.Delete
End If
End Sub

Hope this help