VBA Macro to delete Rows prior to 15 days of Today OR Prior to Current Month

L

Lres81715

Board Regular
Joined
Aug 26, 2015
Messages
147
Hello All,
I'm asking a similar question I asked earlier today but simplifying it.

I have an existing code that filters out and deletes the rows I don't need.

Code: 
   Dim iRow    As Long   
   Dim LastRow    As Long
   Dim sh1   As Worksheet

    Set sh1 = Sheets("TEST2")

    LastRow = sh1.Range("AI1").CurrentRegion.Rows.Count

   For iRow = LastRow To 2 Step -1
      If Cells(iRow, "AI1") < [U][Current Month][/U] Or [U][15 days less than Today if Today is within 15 days of current month][/U] AND [U][Skip Blank Cells][/U] Then
         Rows(iRow).Delete
      End If
   Next iRow

What I want to do is keep any dates Greater than or equal to Month(Date) (today's date) So today is 10/1/2015 If a cell in AI was lets say 02/15/2014, it would be deleted.

This is the part of the code I need to edit for dates. The code above was for clarification
Code: 
[COLOR=#333333]      If Cells(iRow, "AI1") < [/COLOR][U][Current Month][/U][COLOR=#333333] Or [/COLOR][U][15 days less than Today if Today is within 15 days of current month][/U][COLOR=#333333] AND [/COLOR][U][Skip Blank Cells][/U][COLOR=#333333] Then[/COLOR]

I ALSO want to include in the criteria, "if Date in AI is 15 days less than todays date but only if Today falls within first 15 days of the month)" Then

Here's an Example of what I'm talking about.

[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]Today's Date[/TD]
[TD]Column AI[/TD]
[TD]Delete Row?[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]10/1/2015[/TD]
[TD]9/1/2015[/TD]
[TD]Yes[/TD]
[TD]Not current month, past 15 days[/TD]
[/TR]
[TR]
[TD]10/1/2015[/TD]
[TD]9/28/2015[/TD]
[TD]No[/TD]
[TD]Not current month, w/in 15 days[/TD]
[/TR]
[TR]
[TD]10/1/2015[/TD]
[TD]10/2/2015[/TD]
[TD]No[/TD]
[TD]Current month[/TD]
[/TR]
[TR]
[TD]10/1/2015[/TD]
[TD]11/7/2015[/TD]
[TD]No[/TD]
[TD]Past Current month[/TD]
[/TR]
</tbody>[/TABLE]



[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]Today's Date[/TD]
[TD]Column AI[/TD]
[TD]Delete Row?[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]10/15/2015[/TD]
[TD]9/1/2015[/TD]
[TD]Yes[/TD]
[TD]Not current month, past 15 days[/TD]
[/TR]
[TR]
[TD]10/15/2015[/TD]
[TD]9/28/2015[/TD]
[TD]Yes[/TD]
[TD]Not current month, past 15 days[/TD]
[/TR]
[TR]
[TD]10/15/2015[/TD]
[TD]10/2/2015[/TD]
[TD]No[/TD]
[TD]Current month[/TD]
[/TR]
[TR]
[TD]10/15/2015[/TD]
[TD]11/7/2015[/TD]
[TD]No[/TD]
[TD]Past Current month[/TD]
[/TR]
</tbody>[/TABLE]




[TABLE="class: grid, width: 500, align: center"]
<tbody>[TR]
[TD]Today's Date[/TD]
[TD]Column AI[/TD]
[TD]Delete Row?[/TD]
[TD][/TD]
[/TR]
[TR]
[TD]10/20/2015[/TD]
[TD]9/1/2015[/TD]
[TD]Yes[/TD]
[TD]Not current month, past 15 days[/TD]
[/TR]
[TR]
[TD]10/20/2015[/TD]
[TD]9/28/2015[/TD]
[TD]Yes[/TD]
[TD]Not current month, past 15 days[/TD]
[/TR]
[TR]
[TD]10/20/2015[/TD]
[TD]10/2/2015[/TD]
[TD]No[/TD]
[TD]Current month, past 15 days[/TD]
[/TR]
[TR]
[TD]10/20/2015[/TD]
[TD]11/7/2015[/TD]
[TD]No[/TD]
[TD]Past Current month[/TD]
[/TR]
</tbody>[/TABLE]



Long story short. Need to establish Today's date, if column AI has date in same month or greater, don't delete that row.
If Today's Date falls within first 15 days of current month, subtract 15 days from today's date and delete rows that are less than that as in example (Today = 10/10/2015 and AI = 9/18/2015)

Thanks in advance for your help


Edit: The Formula needs to ignore BLANK cells. Blanks are good and I want to keep them on the report.
 
Last edited:
Sort by date Sort by votes
If this is not what you want, maybe it will at least get you started in the right direction.


Code: 
Sub delRows()
Dim sh As Worksheet, lr As Long, i As Long
Set sh = Sheets("TEST2") 'Edit sheet name
lr = sh.Cells.Find("*", , xlFormulas, xlPart, xlByRows, xlPrevious).Row
    For i = lr To 2 Step -1
        If sh.Cells(i, 35) <> "" Then
            If Month(Date) > Month(sh.Cells(i, 35).Value) And Date - sh.Cells(i, 35).Value > 15 Then
                Rows(i).Delete
            End If
        End If
    Next
End Sub
 
Upvote 0
This is sort of working... The problem I'm facing is that it's only deleting the months lower than the current month.
So 9/15/2015 is being deleted... but so is 2/10/2016 and I don't want future dates being deleted

It needs to include a year check too and that's where I'm having a problem. I played with your code a bit and I'm getting nowhere with where to use Year(Date) and Month(Date) appropriately

Code: 
If (sh.Cells(i, 35) < Month(Date) And sh.Cells(i, 35) < Year(Date)) #etc# Then

This isn't working so I'm obviously not on the right track.

Any help in including the Year in this formula would be appreciated.
 
Upvote 0
Ok,

so I "think" I got it... I still have a lot of testing to do but I think this works. (correct me if I'm wrong)

Code: 
If Application.WorksheetFunction.EoMonth(Date, -1) + 1 > Month(sh.Cells(i, 35).Value) And Date - sh.Cells(i, 35).Value > 15 Then
 
Upvote 0
See if this tweaked version will do it.
Code: 
Sub delRows2()
Dim sh As Worksheet, lr As Long, i As Long
Set sh = Sheets("TEST2") 'Edit sheet name
lr = sh.Cells.Find("*", , xlFormulas, xlPart, xlByRows, xlPrevious).Row
    For i = lr To 2 Step -1
        If sh.Cells(i, 35) <> "" And sh.Cells(i, 35).Value < Date Then
            If Month(Date) > Month(sh.Cells(i, 35).Value) And Date - sh.Cells(i, 35).Value > 15 Then
                Rows(i).Delete
            End If
        End If
    Next
End Sub
 
Upvote 0
Thanks JLGWhiz, I ended up figuring out what the problem was. It was another filter I had earlier in my code that was temporarily commented out.

For future reference, this is the code I used to get everything to work.

It deletes all rows where the date is Past the first day of the current month or 15 days (if its the start of the month)


Code: 
Sub aDelRows_LastMthon()
Dim sh1     As Worksheet 
Dim LastRow As Long 
Dim jRow    As Long

Set sh1 = ActiveWorkbook.ActiveSheet 

    LastRow = sh1.Range("AJ1").CurrentRegion.Rows.Count
  
    For jRow = LastRow To 2 Step -1
        If sh1.Cells(jRow, "AI") <> "" Then
            If Application.WorksheetFunction.EoMonth(Date, -1) + 1 > Month(sh1.Cells(jRow, "AI").Value) And Date - sh1.Cells(jRow, "AI").Value > 15 Then
                Rows(jRow).Delete
            End If
        End If
    Next



End Sub

Thanks again JLGWhiz for steering me on the right path.
 
Upvote 0
Lres81715 said:
Thanks JLGWhiz, I ended up figuring out what the problem was. It was another filter I had earlier in my code that was temporarily commented out.

For future reference, this is the code I used to get everything to work.

It deletes all rows where the date is Past the first day of the current month or 15 days (if its the start of the month)


Code: 
Sub aDelRows_LastMthon()
Dim sh1     As Worksheet 
Dim LastRow As Long 
Dim jRow    As Long

Set sh1 = ActiveWorkbook.ActiveSheet 

    LastRow = sh1.Range("AJ1").CurrentRegion.Rows.Count
  
    For jRow = LastRow To 2 Step -1
        If sh1.Cells(jRow, "AI") <> "" Then
            If Application.WorksheetFunction.EoMonth(Date, -1) + 1 > Month(sh1.Cells(jRow, "AI").Value) And Date - sh1.Cells(jRow, "AI").Value > 15 Then
                Rows(jRow).Delete
            End If
        End If
    Next



End Sub

Thanks again JLGWhiz for steering me on the right path.
Click to expand...
Happy to help,
Regards, JLG
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
How restrict copy data from form to sheet based on five days within current month
Replies
3
Views
177
Ali M
A
A
  • Solved
need procedure by message box to inform what exactly missed month
Replies
2
Views
76
Ali M
A
D
  • Solved
Need help creating a formula based on VBA function!
Replies
5
Views
446
Trixterz
T
P
  • Question Question
Need VBA to automatically copy paste rows based on dates of current month.
2
Replies
11
Views
1K
pk970
P
S
  • Solved
When Filter is applied, Excel jumps down multiple rows to (Blanks). How can Filter ignore blanks?
Replies
3
Views
623
Peter_SSs
Peter_SSs

Forum statistics

Threads
1,226,797
Messages
6,193,055
Members
453,772
Latest member
aastupin

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top