VBA Macro Find beginning of current Month, return mm/dd/yyyy

[Lres81715]

I have an IF statement that partially worked on another spreadsheet but isn't doing what it's supposed on my current one.

            If Application.WorksheetFunction.EoMonth(Date, -1) + 1 < Month(sh1.Cells(jRow, "H").Value) Then 'Deletes any Row that is Dates prior to current Month

What it's supposed to do is find Current End of Month (IE 10/31/2015), -1 Month (so 9/30/2015) + 1 day to give me the Beginning of this month (IE 10/1/2015). Then I want to check the Beginning of this month with Column "H". If the Date in Column "H" is LESS THAN the Beginning of this month (IE 10/1/2015) then blah blah blah.

Here is the entire code in context.

Sub dClosedAsOf()



Dim sh1     As Worksheet 'Current Worksheet
Dim LastRow As Long      'Finds last row
Dim jRow    As Long        'Used in row deletion


Set sh1 = Sheets("Closed as of") 




'====Delete Rows from Column F===


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


   For jRow = LastRow To 2 Step -1
            If Application.WorksheetFunction.EoMonth(Date, -1) + 1 <= Month(sh1.Cells(jRow, "H").Value) Then 'Deletes any Row that is Dates prior to the Beginning of Current Month
            Cells(jRow, "F") = "#N/A"
      End If
   Next jRow


    Columns("F").SpecialCells(xlConstants, xlErrors).EntireRow.Delete  
'Note for MrExcel readers, this is just one part of a series of row deletion processes which does a mass delete at the end.  I've edited out everything but just what's involved in this section of the code. 


End Sub

I've provided a book example of what I'm talking about.
https://app.box.com/s/u9crvde2ny5mvco8gq52ktmv4zwlkx3j


Note that simply a <= Month change won't work as there are dates that need to be deleted from the previous year that have higher months.

 

[Eric W]

You can do something like:

Sub dClosedAsOf()

Dim sh1     As Worksheet 'Current Worksheet
Dim LastRow As Long      'Finds last row
Dim jRow    As Long        'Used in row deletion

    Set sh1 = Sheets("Closed as of")

'====Delete Rows from Column F===

    LastRow = sh1.Range("F1").CurrentRegion.Rows.Count
    MyDates = sh1.Range("H1:H" & LastRow)
    
    For jRow = LastRow To 2 Step -1
        If Year(MyDates(jRow, 1)) < Year(Date) Or _
           (Year(MyDates(jRow, 1)) = Year(Date) And Month(MyDates(jRow, 1)) < Month(Date)) Then
'Deletes any Row that is dated prior to the Beginning of Current Month
            sh1.Cells(jRow, "F") = "#N/A"
        End If
    Next jRow

    Columns("F").SpecialCells(xlConstants, xlErrors).EntireRow.Delete

End Sub

Note that I read the entire range in one shot, and only write the #N/A if necessary. This should save a little more time.

Also, since this seems to be a continuation of a previous thread, is there a limited number of codes for the other delete criterion? If so, we can use .Replace instead of a loop which should make it faster.

 

[Lres81715]

Hello Eric W,

First off, yes this does seem to work. The continuation part of it (good memory btw) has to do with multiple reports that use similar code but different criteria and filters. This is a new report that doesn't need that complicated bit of 15 days code as well.

As for the speed, it runs pretty **** fast as compared to the old code so I'm not complaining at all if it takes 7 seconds or 4 seconds. Sure beats 10 minutes =)

Thanks!!! and yes this does work so far.

 

[Jonmo1]

Not sure if it matters anymore, but here's the simplest method I've ever found to get the first day of the current month.

Via Formula
=TODAY()-DAY(TODAY())+1

VBA
x = Date - Day(Date) + 1

 

[Eric W]

Nice, Jonmo1. That would actually shorten the IF to:

If MyDates(jRow, 1) < Date - Day(Date) + 1 Then

 

[Lres81715]

Not sure if it matters anymore, but here's the simplest method I've ever found to get the first day of the current month.

Via Formula
=TODAY()-DAY(TODAY())+1

VBA
x = Date - Day(Date) + 1

Wow, ok yeah that does help and extremely simple.

Thanks Jonmo1!

Eric W,
I was in the process of applying this to the code but you took it a set simpler than I was creating.

I'll be keeping this code close to my heart as it does work like a charm.

 

[Jonmo1]

Glad to help, thanks for the feedback.