Thread: Insert Rows Once End of the Month is Reached

I apologize if the thread title is misleading, but Antonio on the forums provided me with the following code to list dates and b/c I had to start a new thread to ask new questions, this is why this is all here:

His code worked perfectly but needs some tweaking because currently, the code lists the days without any spacings between months, and I would like for it to stop once the end of a month has been reached, then add 4 rows in between before the next month starts up again and continue with the code as normal. I already have the formula to determine the last day of the month which is

PHP Code: 

=Date(Year(A1),Month(A1)+1,0) 


I just need to use this formula in the code so as the code goes through the loop it checks to see if the date is the last day of the month, and if so, insert 4 blank rows and if not, continue with the code as normal.

I also was hoping that maybe it could be modified to work for a user specified range because this is just a small, albeit cumbersome, portion of my spreadsheet that I am working with and the dates aren't all arranged nicely. Thus if one could select a range (columns only) where this would work, that would be optimal. Any further help from Antonio or anyone willing to add the necessary modifications would be appreciated and as always, thank you all very much. You guys are amazing!

The workbook is here

Sub Macro1()
   Dim myYear As Integer
   Dim myDate As Date, d As Byte
   Dim destRow As Long, myDays As Byte

   myYear = 2011
   myDate = DateSerial(myYear, 1, 1)
   myDays = (8 - Weekday(myDate, vbMonday) + 1) Mod 7
   myDate = myDate + myDays - 1
   
   Range("a:a").ClearContents
   Range("a:a").Font.Bold = False
   
   Do
      For d = 0 To 6
         If Year(myDate + d) = myYear Then
            destRow = destRow + 1
            Cells(destRow, "a") = myDate + d
         End If
      Next d
      destRow = destRow + 1
      Cells(destRow, "a") = WorksheetFunction.Text(myDate, "m/d/yy") & " Week"
      Cells(destRow, "a").Font.Bold = True
      
      myDate = myDate + 7
   Loop While Year(myDate) = myYear
   
   Columns("A:A").NumberFormat = "m/d/yy"
End Sub

I should mention that I have tried to get this to work, but I cannot with repeated attempts. This is what I have tried:

Sub Macro1()
   Dim myYear As Integer
   Dim myDate As Date, d As Byte
   Dim destRow As Long, myDays As Byte

   myYear = 2011
   myDate = DateSerial(myYear, 1, 1)
   myDays = (8 - Weekday(myDate, vbMonday) + 1) Mod 7
   myDate = myDate + myDays - 1
   
   
   Range("a:a").ClearContents
   Range("a:a").Font.Bold = False
   
   Do
      For d = 0 To 6
         If Year(myDate + d) = myYear Then
            destRow = destRow + 1
            Cells(destRow, "a") = myDate + d
                If Year(myDate + d) > DateSerial(Year(myDate + d), Month(myDate + d) +1,0)             Then
                Sheets(1).Rows(4).Insert                
                End If
            End If
      Next d
      destRow = destRow + 1
      Cells(destRow, "a") = WorksheetFunction.Text(myDate, "m/d/yy") & " Week"
      Cells(destRow, "a").Font.Bold = True
      
      myDate = myDate + 7
     
   Loop While Year(myDate) = myYear
   
   Columns("A:A").NumberFormat = "m/d/yy"
End Sub

The bolded portion is my attempt at trying to get Excel to realize that as it goes through the loop, if the date is outputs happens to be the last day of the month, it should insert 4 blank rows and then continue with the code. I am no VB buff and I did this with some help from the forums and good ole' google, but would appreciate if someone could please help me figure the rest of this out b/c I cannot get it to work at all. Thanks again.

Hi,

Try this

Sub Macro1()
   Dim myYear As Integer
   Dim myDate As Date, d As Byte
   Dim destRow As Long, myDays As Byte

   myYear = 2011
   myDate = DateSerial(myYear, 1, 1)
   myDays = (8 - Weekday(myDate, vbMonday) + 1) Mod 7
   myDate = myDate + myDays - 1
   
   Range("a:a").ClearContents
   Range("a:a").Font.Bold = False
   
   Do
      For d = 0 To 6
         If Year(myDate + d) = myYear Then
            destRow = destRow + 1
            Cells(destRow, "a") = myDate + d
         End If
      Next d
      destRow = destRow + 1
      Cells(destRow, "a") = WorksheetFunction.Text(myDate, "m/d/yy") & " Week"
      Cells(destRow, "a").Font.Bold = True
      destRow = destRow + 4''' added line here for next entry
      myDate = myDate + 7
   Loop While Year(myDate) = myYear
   
   Columns("A:A").NumberFormat = "m/d/yy"
End Sub

Hi HP RodNuclear

If you've not yet resolved this issue, you'd be best served by posting a current sample file with existing code. In the file, include a worksheet that demonstrates the results you require.

John