[RESOLVED] Find All Mondays In A Month

[SeanK]

How would I determine what the dates are for all Mondays for any given month, for any given year?

For example: If I put 6/2011 in a textbox, what would I need to do in order for my program to tell me that for June of 2011, the Mondays are:

6
13
20
27

[MartinLiss]

Dim intDay As Integer
Dim d As Date

d = Text1.Text
    
Do
    intDay = intDay + 1
    If Format(d + intDay, "ddd") = "Mon" Then
        Debug.Print Format(d + intDay, "d")
    End If
Loop Until Format(d + intDay, "mmm") <> Format(d + intDay + 1, "mmm")

[seenu_1st]

try this

Private Sub Command1_Click()
Dim EndDay As Integer, dt As Date
dt = #6/1/2011#
EndDay = LastDay(2011, 6)

For i = 1 To EndDay
    If Weekday(dt) = 2 Then '2 = monday
        Debug.Print Day(dt)
    End If
    dt = dt + 1
Next
End Sub

Function LastDay( _
    testYear As Integer, _
    testMonth As Integer _
    ) As Integer

    LastDay = Day(DateSerial(testYear, testMonth + 1, 0))

End Function

[LaVolpe]

Both solutions could work. The solution in Post#2 isn't locale aware if that could be a problem.

Optimization point: In either solution, wouldn't you just want to find the 1st Monday, then add 7 to that day's value until you exceed the last day of the month? Loop-wise for a 4 monday month, a max of 10 iterations, otherwise you'll loop the number days of the month.

[jpbro]

This works without too much looping and no string tests:

Sub FindMondays(ByVal p_Month As Long, ByVal p_Year As Long)
   Dim l_TestDay As Long
   
   ' Find first Monday of month
   l_TestDay = 8 - Weekday(DateSerial(p_Year, p_Month, 1), vbTuesday)
   
   Do
      ' Output found Monday in the month
      Debug.Print "Monday in " & MonthName(p_Month) & " " & p_Year & ": " & l_TestDay
      
      l_TestDay = l_TestDay + 7  ' Add a week to previously determined Monday
      
      ' Loop until dateserial overflows into next month
   Loop While Month(DateSerial(p_Year, p_Month, l_TestDay)) = p_Month
End Sub

[SeanK]

Thanks to all for the code and the responses.

[seenu_1st]

if ur problm solved pls mark thread as resolved.