Automatically Archive Historic Or Old Data Based On Ageing Date

[peter renton]

Hi

I have attached a small sample sheet

I dont know if this is possible but i would like to remove a complete row and place it in the next available
row in a sheet called archive if the date in columd H is say 12 months after todays date and then if possible
delete it from the archive sheet if its say 18 months past todays date.

the list continues to grow and i was hoping for a way to self clean the data


Thaks for any help

[Excel Fox]

Private Sub Workbook_Open()

    Dim lng As Long
    Dim dtmDate As Date
    With Worksheets("Contracts")
        For lng = .Cells(.Rows.Count, "H").End(xlUp).Row To 2 Step -1
            If IsDate(.Cells(lng, "H").Value) Then
                dtmDate = .Cells(lng, "H").Value
                If DateSerial(Year(dtmDate), Month(dtmDate) + 12, Day(dtmDate)) <= Date Then
                    .Rows(lng).Cut Worksheets("Archive").Cells(Rows.Count, 1).End(xlUp)(2)
                    .Rows(lng).Delete
                End If
            End If
        Next lng
    End With
    With Worksheets("Archive")
        For lng = .Cells(.Rows.Count, "H").End(xlUp).Row To 2 Step -1
            If IsDate(.Cells(lng, "H").Value) Then
                dtmDate = .Cells(lng, "H").Value
                If DateSerial(Year(dtmDate), Month(dtmDate) + 18, Day(dtmDate)) <= Date Then
                    .Rows(lng).Delete
                End If
            End If
        Next lng
    End With
    
End Sub

[peter renton]

Wow


Thank you very much this is spot on :-)))))

[peter renton]

How do i add the used contracts page so it will auto move the data from that sheet as well? i have tried to add the name in the code
but comes up with an error?

Peter