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