Delete Rows if Date in Column A is Older Than 6 Years

I've been Frankenstein'ing code together to try to delete rows based on the date in column A. If the date is older than 6 years from today then that row needs to be deleted. This is what I've come up with. It runs, but it deletes the entire spreadsheet, haha.

Sub WarrantyExpire()

Dim Row As Long

    For Row = Range("A65536").End(xlUp).Row To 2 Step -1

        If Range("A65536").Value < DateAdd("y", -6, Date) Then
            Cells(Row, 1).EntireRow.Delete

        End If

    Next Row

End Sub

Try this.... Assuming your dates in Column A

Sub DeleteRows()
Dim LR as Integer

With Sheets("Sheet1")  ' Change here what ever sheet name you have 
    LR = .Cells(Rows.Count,"A").End(xlup).Row
    For i = LR to 2 Step - 1
        If .Cells(i,"A").Value < DateAdd("y", -6, Date) Then
            .Rows(i).EntireRow.Delete
        End If
    Next i
End With
End Sub

Thank you for the reply. I just can't get anything to work. It really shouldn't be this difficult. :P

Not an expert myself, but wouldn't it be faster to sort and filter the records by date, then delete the visible rows instead of looping through each record?

Just a thought.

Bill

It's a good idea, and I've tried most everything short of getting a macro going. The list is just too big. Thousands and thousands of records to scroll through.

BantamPCI, here is something that I use. I gathered some code from various places plus figured some out on my own. There are three proc's here. One for turning the Autofilter on and off, one for sorting by date and the other for deleting selected records. Mine uses a date range entered by the user as opposed to being set to look back wards 6 years, but I believe that there is some good you might be able to gather from it. You'll need to make sheet name and probably some other changes. Hope it helps.

Bill

Option Explicit

'--------------------------------------
Sub MonthEntriesSheetAutoFilterOff()
Sheets("MonthEntries").Select
    Selection.AutoFilter
Range("A1").Select
End Sub
'--------------------------------------------------
Sub SortByDateForFiltering()
Application.StatusBar = "Sorting By Work Date "
Application.ScreenUpdating = False

Sheets("MonthEntries").Select
MonthEntriesSheetAutoFilterOff
Range("A:F").Sort _
    Key1:=Range("E1"), Order1:=xlAscending, _
     Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:= _
   xlTopToBottom
End Sub

'--------------------------------------

Sub DateFilterToDeleteOldTimeSheetRecords()
'   Select them by sorting and then filtering by date, _
    then run code to delete visible filtered old records.
Dim StartDate As String
Dim EndDate As String
Dim MonthEntries As Worksheet 'has all entries for numerous months
Dim LastRow As Long
Dim DatesSelected As Range
MsgBox "IMPORTANT: This procedure will delete time sheet entry " _
    & "records. Verify your date range when entering. " _
    & Chr(13) & Chr(13) _
    & "If you want to EXIT this procedure, select OK " _
    & "to clear this message, then select OK or CANCEL from " _
    & "either the Beginning Date or Ending Date input box."

'-----------------------------------------
'sort by date
Sheets("MonthEntries").Select 'sheet with all records no matter month
SortByDateForFiltering 'proc above.  Sorts on col E.

'-----Now get date ranges----------------------------
StartDate = Application.InputBox("Enter the Start Date in MM-DD-YYYY format." _
   & " To exit, select OK or CANCEL without entering anything.", _
     "Beginning Date", Type:=3)

If StartDate = CStr(False) Then 'CANCEL selected
  MsgBox "You have chosen to close this procedure."
  Exit Sub
End If

If StartDate = "" Or StartDate = " " Then 'OK selected
    MsgBox "You have chosen to close this procedure."
    Exit Sub
End If

'----------------------------
EndDate = Application.InputBox("Enter the Ending Date in MM-DD-YYYY format." _
   & " To exit, select OK or CANCEL without entering anything.", _
     "Ending Date", Type:=3)

If EndDate = CStr(False) Then 'CANCEL selected
  MsgBox "You have chosen to close this procedure."
  Exit Sub
End If

If EndDate = "" Or EndDate = " " Then 'OK selected
    MsgBox "You have chosen to close this procedure."
    Exit Sub
End If

'still need to add code to make sure the date is in DATE format
'----------------------------------------------
''*********using test sheet named MonthEntries
'now filter
Sheets("MonthEntries").Activate
ActiveSheet.Range("A1").End(xlDown).AutoFilter Field:=5, _
        Criteria1:=">=" & StartDate, _
        Criteria2:="<=" & EndDate
'is filtering correctly,
'-------------------------------------------------------

'do not want to delete headers from row 1.
'NOTE: making rows to be deleted visible, then deleting them inside With stmnt
Set DatesSelected = ActiveSheet.UsedRange.Offset(1, 0) _
     .SpecialCells(xlCellTypeVisible)
With DatesSelected 'OK to use range variable name here
  .EntireRow.Delete
End With
'----------------------------------------------

Columns("A:F").AutoFit
Range("A1").Select

'------------------------------------------------
'remove filtering
Sheets("MonthEntries").Select
    Selection.AutoFilter
End Sub

It is as simple as it is...... try this........ attachment.....

Great!. Always looking for something simpler and to learn from. Thanks.

Bill