Macro for Removing Dates 11 Days in Future

EmilyElle

New Member
Joined
Oct 13, 2019
Messages
3
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

Well-known Member
Joined
Aug 31, 2016
Messages
2,907
.
Code:
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

New Member
Joined
Oct 13, 2019
Messages
3
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?

.
Code:
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

Well-known Member
Joined
Aug 31, 2016
Messages
2,907
.
Why are you filtering the rows ?

Try without filtering.
 

Logit

Well-known Member
Joined
Aug 31, 2016
Messages
2,907
.
Hmm ... would you be ok posting your workbook to a cloud site like DropBox.com or similar ?

Provide the download link here.
 

Forum statistics

Threads
1,077,993
Messages
5,337,602
Members
399,156
Latest member
RaudMees

Some videos you may like

This Week's Hot Topics

Top