Private Sub UserForm_Initialize()
Me.cbMonth.List = Application.GetCustomListContents(4)
End Sub
Private Sub cbMonth_Change()
Dim dte As Date, i As Long
If cbMonth = "" Then
cbWeek.Clear
Exit Sub
End If
dte = Me.cbMonth & " 15, " & Year(Date)
Me.cbWeek.Clear
For i = 1 To WeeksInMonth(dte)
Me.cbWeek.AddItem "Week" & i
Next i
End Sub
Private Function WeeksInMonth(tDate As Date)
Dim sDate As Date ' First of the month
Dim eDate As Date ' Last of the month
sDate = DateSerial(Year(tDate), Month(tDate), 1)
eDate = DateSerial(Year(tDate), Month(tDate) + 1, 0)
WeeksInMonth = DateDiff("ww", sDate, eDate) + 1
End Function