How to return date of every month i entered

[ke9c]

Is there a way i can return an array in VBA of date of every monday in the month i specified?

thks

 

[AlphaFrog]

Sub Mondays_Array()

    Dim dMondays() As Date
    Dim strMonth As String
    Dim lYear As Long
    Dim d As Date
    Dim i As Integer

    strMonth = "[COLOR="Red"]January[/COLOR]"
    lYear = [COLOR="Red"]2011[/COLOR]
    
    ReDim dMondays(1 To 4)
    d = DateValue(strMonth & ",1 " & lYear)
    
    Do While Format(d, "mmmm") = strMonth
        If Weekday(d, vbMonday) = 1 Then
            i = i + 1
            If i = 5 Then ReDim Preserve dMondays(1 To 5)
            dMondays(i) = d
        End If
        d = d + 1
    Loop
    
   [COLOR="Green"] ' Display Mondays[/COLOR]
    For i = 1 To UBound(dMondays)
        strTheMondays$ = strTheMondays$ & Format(dMondays(i), "dddd mmm dd, yyyy") & vbCr
    Next i
    MsgBox strTheMondays
    
End Sub

 

[Peter_SSs]

For what it's worth, here's a slight variation that doesn't require checking each day of the month. I know the saving is insignificant unless many arrays are being processed but since I had fiddled with this code I thought I might as well post the results.

Sub MondayArray()
    Dim dMondays() As Date
    Dim strMonth As String, strTheMondays As String
    Dim lYear As Long, lNum As Long, L As Long
    Dim d As Date
    
    strMonth = "January"
    lYear = 2011
    
    d = DateValue(strMonth & ",1 " & lYear)
    d = d + 7 - Weekday(d, 3)
    lNum = IIf(Month(d + 28) = Month(d), 5, 4)
    ReDim dMondays(1 To lNum)
    For L = 1 To lNum
        dMondays(L) = d + (L - 1) * 7
    Next L
    
    ' Display Mondays
    For L = 1 To lNum
        strTheMondays = strTheMondays & Format(dMondays(L), "dddd mmm dd, yyyy") & vbCr
    Next L
    MsgBox strTheMondays

End Sub