I am trying to get all the dates for the Mondays in the current month. For example, in the current month May 2021 we would have: 3/05/2021, 10/05/2021, 17/05/2021, 24/05/2021, 31/05/2021.

On investigation I found this answer for an older question which helps toCalculate the number of weeks in a month, however this shows 6 as an answer. Which is correct (See shared calendar). However I wish to count only the Mondays on the month.

I also have a complementary code which gives me the number of Mondays in the month:

Sub NumMondays() Dim i As Integer Dim num_mondays As Integer Dim test_date As Date Dim orig_month As Integer month_name = Format(Date, "mmmm") year_name = Format(Date, "yyyy") ' Get the first day of the month. test_date = CDate(month_name & " 1, " & year_name) ' Count the Mondays. orig_month = Month(test_date) Do num_mondays = num_mondays + 1 test_date = DateAdd("ww", 1, test_date) Loop While (Month(test_date) = orig_month) Debug.Print test_date Debug.Print orig_month Debug.Print num_mondays
End Sub

Such code prints 5 for number of Mondays, however I have been unable to convert this to the actual dates of such Mondays. Any suggestions?

Thanks a lot in advance

4 Answers

A Functional Solution

A good approach is to use a function that will return a collection of the days from a specified month.

This is similar to other approaches provided — however, this adds a bit of performance and more importantly intellisense for the day of the week.

Public Function GetMonthDays(dayToGet As VbDayOfWeek _
, monthToGetFrom As Long _
, yearToGetFrom As Long) As Collection Set GetMonthDays = New Collection ' First Starting date, and will be used ' for incrementing to next date/next day. Dim nextDate As Date nextDate = DateSerial(yearToGetFrom, monthToGetFrom, 1) ' Loop until month changes to next month. Do While month(nextDate) = monthToGetFrom ' If weekday matches, then add and ' increment to next week (7 days) If Weekday(nextDate) = dayToGet Then GetMonthDays.Add nextDate nextDate = nextDate + 7 ' Day did not match, therefore increment ' 1 day until it does match. Else nextDate = nextDate + 1 End If Loop
End Function

Example

Here is a basic example of how to use it.

Sub testGetMonthDays() Dim mondayDate As Variant For Each mondayDate In GetMonthDays(vbMonday, month(Date), year(Date)) Debug.Print mondayDate Next
End Sub

5/3/2021
5/10/2021
5/17/2021
5/24/2021
5/31/2021 

Try the next code, please:

Sub NumMondays() Dim i As Long, month_name, year_name, num_mondays As Integer Dim test_date As Date, orig_month As Integer, arrMondays, k As Long month_name = Format(Date, "mmmm") year_name = Format(Date, "yyyy") ' Get the first day of the month. test_date = CDate(month_name & " 1, " & year_name) orig_month = month(test_date) ReDim arrMondays(4) 'extract and count Mondays: Do If Weekday(test_date, vbMonday) = 1 Then arrMondays(k) = test_date: k = k + 1: num_mondays = num_mondays + 1 End If test_date = test_date + 1 Loop While (month(test_date) = orig_month) ReDim Preserve arrMondays(k - 1) Debug.Print "Current month no = " & orig_month Debug.Print "No of Mondays = " & num_mondays Debug.Print Join(arrMondays, ", ")
End Sub

1

Brute force approach

Sub tester() Dim dt For Each dt In GetDayDates(2021, 5, "Mon") Debug.Print dt Next dt
End Sub
Function GetDayDates(yr As Long, mon As Long, d As String) Dim dt As Date, col As New Collection dt = DateSerial(yr, mon, 1) Do While Month(dt) = mon If Format(dt, "ddd") = d Then col.Add dt dt = dt + 1 Loop Set GetDayDates = col
End Function

Different approach. There is a somewhat known Excel formula that provides the Monday of a Given Weeknumber and Year (=DATE(A2, 1, -2) - WEEKDAY(DATE(A2, 1, 3)) + B2 * 7) [A2 is the Year, B2 is the Weeknumber]. In this case I loop all weeks on a month and use that formula on each week.

Sub CaseOfTheMondays() Dim inDate As Date, sDate As Date, eDate As Date, sYear As Date, mDate As Date Dim cMonth As Integer, i As Integer, x As Integer inDate = InputBox("Enter a valid date") If IsDate(inDate) Then ThisWorkbook.Worksheets(1).Columns("A").ClearContents sDate = DateAdd("d", -(Format(inDate, "d") - 1), inDate) eDate = DateAdd("m", 1, inDate) - (Format(inDate, "d") + 1) sYear = DateAdd("m", -(Format(inDate, "m") - 1), DateAdd("d", -(Format(inDate, "d") - 1), inDate)) cMonth = Format(inDate, "m") sWeek = WorksheetFunction.WeekNum(sDate, vbMonday) eWeek = WorksheetFunction.WeekNum(eDate, vbMonday) x = 1 For i = sWeek To eWeek mDate = DateAdd("d", -3, sYear) - Weekday(DateAdd("d", 2, sYear)) + (i * 7) If Format(mDate, "m") = cMonth Then ThisWorkbook.Worksheets(1).Cells(x, 1).Value = mDate x = x + 1 End If Next i Else MsgBox "invalid date" End If
End Sub

Your Answer

Sign up or log in

Sign up using Google Sign up using Facebook Sign up using Email and Password Submit

Post as a guest

Post Your Answer Discard

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge that you have read and understand our privacy policy and code of conduct.