Split Periodic Date in months

[arcootje]

Can anybody help me:

Start: 05-01-2005
End: 06-02-2006

I would like to extract the months:
05-01-2005
31-01-2005

01-02-2005
28-02-2005

...

01-02-2006
06-02-2006

etc.
De data is in Sheet1
The months must be in Sheet 2

Can anybody help me?

 

[erik.van.geit]

Hi,

try this

Option Explicit

Sub listdates()
'Erik Van Geit
'061011
'EXAMPLE
'START WITH
'10/11/05
'24/03/06
'TO GET
'10/11/05
'30/11/05
' 1/12/05
'31/12/05
' 1/01/06
'31/01/06
' 1/02/06
'28/02/06
' 1/03/06
'24/03/06


Dim startDate As Long
Dim endDate As Long
Dim startMonth As Long
Dim endMonth As Long
Dim startYear As Long
Dim endYear As Long

Dim firstM As Integer
Dim lastM As Integer
Dim firstDay As Integer
Dim lastDay As Integer

Dim y As Integer
Dim m As Integer

Dim SH1 As Worksheet
Dim SH2 As Worksheet

Set SH1 = Sheets(1)
Set SH2 = Sheets(2)

startDate = SH1.Range("A1")
startMonth = Month(startDate)
startYear = Year(startDate)
endDate = SH1.Range("A2")
endMonth = Month(endDate)
endYear = Year(endDate)

    If startDate > endDate Then
    MsgBox "Your startdate is higher then your enddate!", 48, "ERROR"
    Exit Sub
    End If

    With SH2
    'change this line to suit your needs: clearing entire column might be too much
    .Columns(1).ClearContents

        For y = startYear To endYear
        
            firstM = IIf(y = startYear, startMonth, 1)
            lastM = IIf(startYear <> endYear And y <> endYear, 12, endMonth)
            
            For m = firstM To lastM
            firstDay = IIf(y = startYear And m = startMonth, Day(startDate), 1)
            .Cells(Rows.Count, 1).End(xlUp)(2) = DateSerial(y, m, firstDay)
            lastDay = IIf(y = endYear And m = lastM, Day(endDate), lastday_of_month(m, y))
            .Cells(Rows.Count, 1).End(xlUp)(2) = DateSerial(y, m, lastDay)
            Next m

        Next y
    
    End With

End Sub

Function lastday_of_month(m, y)
lastday_of_month = Format(DateSerial(y, m + 1, 1) - 1, "d")
End Function

should work for all imaginable situations

kind regards,
Erik

 

[arcootje]

Thanx it works super!!

 

[erik.van.geit]

you're WELCOME !

you must be really sure "it works" after six months of testing

 

[arcootje]

i post a "thank you" because i have a little question about this:
can in the first row be placed the first row and the last row of the action

 

[erik.van.geit]

please clarify with an example