Solved: copy late items to new sheet

[john3j]

I am trying to find a way to run a code that will delete each row in the sheet if the two criteria are not met for each sheet.

The criteria are if each cell in the range AC2:AC1000 is empty AND if each cell in the range AD2:AD1000 is less than the current date. These are the only rows that I want to report.

If anyone can help me out, please let me know.

Thanks!:banghead:

[rbrhodes]

Hi j,

This will check if Col AC is truly empty, then check all cells in Col AD from the bottom up, deleting rows on the way...


Option Explicit
Sub crit2()
Dim i As Long
Dim Lastrow As Long
'Get last row of data Col AC
Lastrow = Range("AC1001").End(xlUp).Row

If Lastrow = 1 Then
'Col is blank
For i = 1000 To 2 Step -1
'Check AD rows
If Range("AD" & i) < Date Then
'Kill it
Range("AD" & i).EntireRow.Delete
End If
Next i
End If

End Sub

[mbarron]

The following will delete rows where the AC column is not blank and the AD column contains a date equal to or greater than the current date.


Sub deleteRows()
Dim i As Long

For i = 1000 To 2 Step -1
If Not (Cells(i, 29) = "" And Cells(i, 30) < Date) Then
Cells(i, 1).EntireRow.Delete
End If
Next

End Sub