Macro for Removing Dates 11 Days in Future

[EmilyElle]

Hello,

I'm trying to create a macro that would do the following functions - can you please advise what the code would be? Thank you.

• Keep any row with a value in column D
• Remove any rows where column D is blank and is 11 days out in column G
• Remove any rows where date is 11 days out in column G

 

[Logit]

.

Option Explicit


'Keep any row with a value in column D
'Remove any rows where column D is blank and is 11 days out in column G
'Remove any rows where date is 11 days out in column G


Sub DeleteRows()


Dim i As Integer
Dim Rng As Range
Dim WorkRng As Range    ', WorkRng2 As Range
Dim xRows As Long
Dim nDate As Date


Set WorkRng = Sheets("Sheet1").Range("D1:D200")     'edit range here


nDate = Date
xRows = WorkRng.Rows.Count
Application.ScreenUpdating = False


For i = xRows To 2 Step -1
    If WorkRng.Rows(i).Value = 0 And WorkRng.Rows(i).Offset(0, 3).Value = nDate + 11 Then WorkRng.Rows(i).EntireRow.Delete XlDeleteShiftDirection.xlShiftUp
    If WorkRng.Rows(i).Offset(0, 3).Value = nDate + 11 Then WorkRng.Rows(i).EntireRow.Delete XlDeleteShiftDirection.xlShiftUp
Next


Application.ScreenUpdating = True
End Sub

 

[EmilyElle]

I'm showing that it's deleting some rows but not all the ones. If you filter the blanks in column D there should be nothing past 11 days from today's date. Maybe I'm doing something wrong on my end?

.

Option Explicit


'Keep any row with a value in column D
'Remove any rows where column D is blank and is 11 days out in column G
'Remove any rows where date is 11 days out in column G


Sub DeleteRows()


Dim i As Integer
Dim Rng As Range
Dim WorkRng As Range    ', WorkRng2 As Range
Dim xRows As Long
Dim nDate As Date


Set WorkRng = Sheets("Sheet1").Range("D1:D200")     'edit range here


nDate = Date
xRows = WorkRng.Rows.Count
Application.ScreenUpdating = False


For i = xRows To 2 Step -1
    If WorkRng.Rows(i).Value = 0 And WorkRng.Rows(i).Offset(0, 3).Value = nDate + 11 Then WorkRng.Rows(i).EntireRow.Delete XlDeleteShiftDirection.xlShiftUp
    If WorkRng.Rows(i).Offset(0, 3).Value = nDate + 11 Then WorkRng.Rows(i).EntireRow.Delete XlDeleteShiftDirection.xlShiftUp
Next


Application.ScreenUpdating = True
End Sub

 

[Logit]

.
Why are you filtering the rows ?

Try without filtering.

 

[EmilyElle]

It doesn't do anything if I don't apply the filters. I try to run the Macro and the screen remains the same.

.
Why are you filtering the rows ?

Try without filtering.

 

[Logit]

.
Hmm ... would you be ok posting your workbook to a cloud site like DropBox.com or similar ?

Provide the download link here.