Function to return date of Monday of this week or another week

[mdlueck]

I cooked up a quick function to consistently calculate the date of Monday of either the current week, or the Monday of a given week of any valid date.

I coded it in USA format where Sunday is the first day of the week.

Public Function datetimeutils_MondayOfThisWeek(ByVal dtmToday As Date) As Date
  On Error GoTo Err_datetimeutils_MondayOfThisWeek

  Dim intWeekdayNum As Integer

  intWeekdayNum = Weekday(dtmToday)

'Note: No need to define an error return value. "12:00:00 AM" will be returned
'as that is the default value of a Date datatype variable

  Select Case intWeekdayNum
    Case vbSunday
      datetimeutils_MondayOfThisWeek = DateAdd("d", 1, dtmToday)
    Case vbMonday
      datetimeutils_MondayOfThisWeek = dtmToday
    Case vbTuesday
      datetimeutils_MondayOfThisWeek = DateAdd("d", -1, dtmToday)
    Case vbWednesday
      datetimeutils_MondayOfThisWeek = DateAdd("d", -2, dtmToday)
    Case vbThursday
      datetimeutils_MondayOfThisWeek = DateAdd("d", -3, dtmToday)
    Case vbFriday
      datetimeutils_MondayOfThisWeek = DateAdd("d", -4, dtmToday)
    Case vbSaturday
      datetimeutils_MondayOfThisWeek = DateAdd("d", -5, dtmToday)
    Case Else
      Call errorhandler_MsgBox("Module: modshared_datetimeutils, Function: datetimeutils_MondayOfThisWeek(), Error: Unsupported intWeekdayNum value of: " & intWeekdayNum)
      GoTo Exit_datetimeutils_MondayOfThisWeek
  End Select

Exit_datetimeutils_MondayOfThisWeek:
  Exit Function

Err_datetimeutils_MondayOfThisWeek:
  Call errorhandler_MsgBox("Module: modshared_datetimeutils, Function: datetimeutils_MondayOfThisWeek()")
  Resume Exit_datetimeutils_MondayOfThisWeek

End Function

I could not find a way to grab the current date in the function declaration and have the function arg Optional. That would have been:

Public Function datetimeutils_MondayOfThisWeek(Optional ByVal dtmToday As Date = [B][COLOR=Red]Date[/COLOR][/B]) As Date

which raises a compiler error as indicated:
"Compiler error:
Constant expression required"

So unfortunately usually the usage for now must be:

? datetimeutils_MondayOfThisWeek(Date)
11/5/2012

And the error condition will be returned as:

? datetimeutils_MondayOfThisWeek(Date)
12:00:00 AM

Any suggestions how to make the arg optional?

I am toying with the idea of supporting an optional Monday start of the week to make it compatible with Europe.

Any input? TIA!

 

[pbaldy]

Well, here's how to make it optional:

http://support.microsoft.com/kb/210179

and wouldn't either of these be simpler (dte is the given date):

myDate = dte - Weekday(dte, vbMonday) + 1
myDate = dateadd("d",1-weekday(dte,vbMonday),dte)

 

[mdlueck]

Well, here's how to make it optional:

http://support.microsoft.com/kb/210179

Exactly the syntax I used. The KB article did not provide an example of defaulting a date. Strings, Numbers, and Boolean are easy as pie!

and wouldn't either of these be simpler (dte is the given date):

myDate = dte - Weekday(dte, vbMonday) + 1
myDate = dateadd("d",1-weekday(dte,vbMonday),dte)

Off to my test tubes to check those out. Thanks!

I have coded up Europe mode, an optional flag (Boolean defaulting to False) that indicates to consider Sunday the last/first day of the week.

 

[pbaldy]

Perhaps I'm missing something, but this worked as expected:

Public Function GetMonday(Optional InputDate As Variant) As Date
  If IsMissing(InputDate) Then
    InputDate = Date
  End If

  GetMonday = InputDate - Weekday(InputDate, vbMonday) + 1
End Function

?GetMonday(#11/1/2012#)
10/29/2012
?GetMonday(Date)
11/5/2012
?GetMonday()
11/5/2012

 

[gemma-the-husky]

i thought there would be a slick way, as paul demonstrated

i tend to do something like this which uses a few more clock ticks

while weekday(indate)<>vbmonday
      indate = indate-1
wend

 

[mdlueck]

Perhaps I'm missing something, but this worked as expected:

That indeed was helpful. Interesting to note that the Variant data type supports IsMissing(). +1 for the dreaded Variant in this case. Thank you very much.

This appears to be working correctly for both USA and Europe style calendars:

Public Function datetimeutils_MondayOfThisWeek(Optional ByVal varInputDate As Variant, Optional ByVal flgEuropeMode As Boolean = False) As Date
  On Error GoTo Err_datetimeutils_MondayOfThisWeek

  'Detect if the varInputDate arg was not provided
  If IsMissing(varInputDate) Then
    varInputDate = Date
  End If

  If flgEuropeMode = False Then
    datetimeutils_MondayOfThisWeek = DateAdd("d", 1 - Weekday(varInputDate, vbSunday), varInputDate) + 1
  Else
    datetimeutils_MondayOfThisWeek = DateAdd("d", 1 - Weekday(varInputDate, vbMonday), varInputDate)
  End If

Exit_datetimeutils_MondayOfThisWeek:
  Exit Function

Err_datetimeutils_MondayOfThisWeek:
  Call errorhandler_MsgBox("Module: modshared_datetimeutils, Function: datetimeutils_MondayOfThisWeek()")
  'Note: No need to define an error return value. "12:00:00 AM" will be returned
  'as that is the default value of a Date datatype variable
  Resume Exit_datetimeutils_MondayOfThisWeek

End Function

Feedback please.

 

[boblarson]

Bob Askew (Raskew) coded this several years ago:

Function fNextNthDay(dteStart As Date, _
                     intWeekday As Integer, Optional blnPrevious As Boolean) As Date
'************************************************* *
'Purpose: Round date up to next specified
' weekday
' The optional parameter blnPrevious specifies if you want
' the PREVIOUS date.  The default is to get the NEXT date.
 
 
'Inputs:
' 1) ? fNextNthDay(#4/18/06#, vbWednesday)  
' 2) ? fNextNthDay(#4/19/06#, vbWednesday)
' 3) ? fNextNthDay(#4/20/06#, vbWednesday)
' 4) ? fNextNthDay(#4/19/06#, vbWednesday, True)
' 5) ? fNextNthDay(#4/20/06#, vbWednesday, True)
'Output:
' 1) 4/19/06
' 2) 4/19/06
' 3) 4/26/06
' 4) 4/19/06
' 5) 4/19/06
'************************************************* *
    If blnPrevious Then
        fNextNthDay = (dteStart - Weekday(dteStart) + _
                       intWeekday + _
                       IIf(Weekday(dteStart) < intWeekday, -7, 0))
    Else
        fNextNthDay = dteStart - Weekday(dteStart) + _
                      intWeekday + _
                      IIf(Weekday(dteStart) > intWeekday, 7, 0)
    End If
End Function

 

[pbaldy]

Happy to help. What you have looks good, though in retrospect I might also add a test to make sure the input is a date (using IsDate) if it could possibly be passed something other than a date.

 

[mdlueck]

Another excellent idea, Paul!

Public Function datetimeutils_MondayOfThisWeek(Optional ByVal varInputDate As Variant, Optional ByVal flgEuropeMode As Boolean = False) As Date
  On Error GoTo Err_datetimeutils_MondayOfThisWeek

  'Detect if the varInputDate arg was not provided
  If IsMissing(varInputDate) Then
    varInputDate = Date
  Else
    'Check if the arg received is a valid date
    If Not IsDate(varInputDate) Then
      Call errorhandler_MsgBox("Module: modshared_datetimeutils, Function: datetimeutils_MondayOfThisWeek(), Error: varInputDate is not a valid date, received: " & varInputDate)
      GoTo Exit_datetimeutils_MondayOfThisWeek
    End If
  End If

  If flgEuropeMode = False Then
    'USA Mode
    datetimeutils_MondayOfThisWeek = DateAdd("d", 1 - Weekday(varInputDate, vbSunday), varInputDate) + 1
  Else
    'Europe Mode
    datetimeutils_MondayOfThisWeek = DateAdd("d", 1 - Weekday(varInputDate, vbMonday), varInputDate)
  End If

Exit_datetimeutils_MondayOfThisWeek:
  Exit Function

Err_datetimeutils_MondayOfThisWeek:
  Call errorhandler_MsgBox("Module: modshared_datetimeutils, Function: datetimeutils_MondayOfThisWeek()")
  'Note: No need to define an error return value. "12:00:00 AM" will be returned
  'as that is the default value of a Date datatype variable
  Resume Exit_datetimeutils_MondayOfThisWeek

End Function

? datetimeutils_MondayOfThisWeek("foo", True)

correctly pops the custom MsgBox.