Macro to delete rows 365 days from today()

[bbqsmokeman]

I have had great help in the past on this workbook and am still learning.
I know this is probably simple but for some reason no matter which macros I use it messes the sheets calendars or doesn't work.
Basically I created a 'sort' macro to run in A15:J500 and once complete move all data down one row to leave A14 open for new entry. The code works real good and fast so I thought I would now add a macro to check dates A15 downwards and if 365 days old from recent entry or today() then delete rows (similar to keeping a rolling calendar). One macro deleted almost everything even the calendars and one doesn't seem to function at all. I know it's probably something real simple but it eludes me

Codes I have tried but are not working:

Sub DeleteOlder()

'Delete rows if expiry date < today + 365
For i = 15 To FinalRow
If Range("A" & i).Value < Date + 365 Then
Rows(i).Delete
End If
Next i

End Sub



'Sub DeleteOlder()

'lr = Cells(Rows.Count, "A").End(xlUp).Row
'Range("A15:A" & lr).AutoFilter Field:=1, _
'Criteria1:="<" & Date - 365
'Range("A15:A" & lr) _
'.SpecialCells(xlCellTypeVisible).EntireRow.Delete
'Range("A15:A" & lr).AutoFilter
'End Sub


'Sub DeleteOlder()

'lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
'For x = lastrow To 15 Step -1
'If Cells(x, 15).Value <= Date - 365 Then
'Cells(x, 15).EntireRow.Delete
'End If
'Next

'End Sub

I didn't want to keep rewriting code so i expressioned out the ones that I couldn't get working except most recent one which is active but wanted to keep them for reference to study more.

I am including the sample and it may look familiar as it was recently up here for help earlier.
I am still reviewing the recent code (calendar transfer each year) as I need to understand it so I can modify and apply to the 'summary' sheet as well.

Can the date older than 365 run from the 'summary' and move across all the worksheets like the calendar macro?

thanks

 

[Hui]

You haven't defined FinalRow and so it is 0
Also when deleting Rows work from highest to lowest

try:

Sub DeleteOlder()
Dim FinalRow As Integer
'Delete rows if expiry date < today + 365
FinalRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = FinalRow to 15 step -1
  If Range("A" & i).Value < Date + 365 Then
  Rows(i).Delete Shift:=xlUp
  End If
Next i

End Sub

 

[bbqsmokeman]

Hui
thank you for the help.
I did try the code and it ran ok but it deleted everything even the current date as well as the 2 yrly calendars I had in the L:BG column.
I may not have explained myself correctly so my apologies. I want to keep all data from A:J starting at A15 if the date is current date or most recent entry or 365 days young from the today() type value/formula if needed to be used (which I have in G3 on each sheet (formula for something else) except Summary) and count backwards 365 days and keep all the entries but anything older delete the rows. This is why I created the sort macro to ensure the data is sorted newest to oldest pushing the old dates below the calendar row to avoid accidentally losing them.
I hope this helps clarify what I am attempting to do
An ideal state would be to exclude the Summary page but run the code from the Summary page and do all sheets that are named.

 

[Hui]

Try this:

Sub DeleteOlder()
Dim FinalRow As Integer
'Delete rows if expiry date < today + 365
FinalRow = Cells(Rows.Count, "A").End(xlUp).Row
For i = FinalRow To 15 Step -1
  If Range("A" & i).Value < (Date - 365) Then
  Range("A" + CStr(i) + ":J" + CStr(i)).Delete Shift:=xlUp
  End If
Next i

End Sub

 

[bbqsmokeman]

Hui
This works great! Thank you! Is there a way to make it run faster and can it do any and all sheets in workbook at one time that have a name on the tab except the Summary page (exclude this page)? Or will I have to run the macro on each sheet individually?

 

[Hui]

I assume you also don't want to run it on the 2016 - 2021 Calendar Replace worksheet

Sub DeleteOlder()
Dim FinalRow As Integer
Dim sh As Worksheet

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

For Each sh In Worksheets
  If sh.Name <> "Summary" And sh.Name <> "2016 - 2021 Calendar Replace" Then
  sh.Select
  
  'Delete rows if expiry date < today + 365
  FinalRow = Cells(Rows.Count, "A").End(xlUp).Row
  For i = FinalRow To 15 Step -1
  If Range("A" & i).Value < (Date - 365) Then
  Range("A" + CStr(i) + ":J" + CStr(i)).Delete Shift:=xlUp
  End If
  Next i
  End If
Next sh

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic

End Sub

 

[bbqsmokeman]

Hui
Truly an excel ninja! Wow, I hope one day I will be as good as you and all those who carry the title excel ninja. This works great! Thank you very much! Now to learn what the code does, why it's written the way it is and all that fun stuff called learning so I too can one day be as good as you.
Again thank you very much!

 

[Monty]

Hui...You are truly Excel Ninja!!!