Code: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
Reply With Quote
Bookmarks