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
Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.
”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.