Sub DelOOETranslations() 'Assumes that oldest or OOE are first Dim WS As Worksheet Dim MaxRow As Long, I As Long Dim ThisDate As Date Set WS = ActiveSheet MaxRow = LastRow I = 6 Do '---> Check for Cell if Date and Affect to ThisDate If Len(WS.Cells(I, "D")) = 20 And Mid(WS.Cells(I, "D"), 3, 1) = "/" Then ThisDate = DateValue(Left(WS.Cells(I, "D"), 10)) End If '---> Test if Date captured < now then delete or else increment counter go next line If ThisDate < DateValue(Now) Then WS.Cells(I, "A").EntireRow.Delete MaxRow = MaxRow - 1 Else I = I + 1 End If Loop Until I > MaxRow '---> Advise results to user 'MsgBox ("All date prior to " & DateValue(Now) & " have been deleted with their coresponding rows successfully.") End Sub
Gain unlimited access to on-demand training courses with an Experts Exchange subscription.Get Access
When asked, what has been your best career decision?
Deciding to stick with EE.
Being involved with EE helped me to grow personally and professionally.