PDA

View Full Version : Create a date entry for each day of the month



simora
09-14-2011, 02:12 PM
I have 3 worksheets formatted exactly alike.
I need a solution so that when the user enters a month name in Cell B41 like this : October
& year in cell B42 like this : 2011
it enters the date as the 1st of that month & year in cell A2 like this :
Saturday, October 01, 2011
then copies down to the end of the month so that it creates an entry for each day of the month.

Formatted like below starting Col A 2:
Saturday, October 01, 2011
Sunday, October 02, 2011
Monday, October 03, 2011
etc etc.....

How do I format this so that it knows how many days are in that month , 28, 29, 30 or 31
This range is going to be duplicated to the 2 other sheets, and the date information will be used in other calculations.

Thanks

JKwan
09-14-2011, 02:45 PM
here is something quick and dirty

Sub FillDates()
Dim lDay As Long
Dim MyDate As Date

For lDay = 1 To NumberOfDays(Cells(41, "B"))
MyDate = Cells(41, "B") & "/" & lDay & "/" & Cells(42, "B")
Cells(lDay + 1, "A") = Format(MyDate, "dddd, mmmm dd, yyyy")
Next lDay
End Sub
Private Function IsLeapYear(iYear As Integer)
IsLeapYear = Month(DateSerial(iYear, 2, 29)) = 2
End Function
Private Function NumberOfDays(sMonth As String) As Long
Dim LeapYear As Boolean

Select Case UCase(sMonth)
Case "JANUARY", "MARCH", "MAY", "JULY", "AUGUST", "OCTOBER", "DECEMBER"
NumberOfDays = 31

Case "FEBRUARY"
LeapYear = IsLeapYear(Cells(42, "B"))
If LeapYear Then
NumberOfDays = 29
Else
NumberOfDays = 28
End If

Case "APRIL", "JUNE", "SEPTEMBER", "NOVEMBER"
NumberOfDays = 30

Case Else
NumberOfDays = 0
End Select
End Function

simora
09-14-2011, 03:06 PM
Thanks JKwan

Worked perfectly.

JKwan
09-14-2011, 05:39 PM
You are very welcome