Universal Return Particular Date Function (1 Viewer)

Status
Not open for further replies.

mresann

Registered User.
Local time
Today, 04:08
Joined
Jan 11, 2005
Messages
357
There have been a couple of examples in this thread that has provided a return of a date from an occurrence of a particular day of the week, such as "3rd Wednesday in Month" function earlier. The idea was to simplify the function to a tight algorithm so it could be used for any Day of Week, as well as the occurrence of that particular Day of Week within the month (i.e. "First Tuesday of month", "Third Sunday of month", etc.). In addition, the function can also return the LAST particular occurrence of a Day of Week within the month (i.e. "Last Friday of month").

The function is called "fncReturnDate." It takes three required arguments:

lngWeekday--The Day of Week needed for the return, in number format (i.e. Sun=1, Mon=2, ...Sat=7) You can use VB Constants to clarify code. For instance, vbSunday=1, vbMonday=2,...vbSaturday=7.

lngOccurrence--There are actually 2 different scenarios for this input, both in number format.

  1. If you are looking for a particular occurrence of the Day of Week in the month, then enter a number of the particular occurrence of the Day of Week you are looking for (i.e. 1="First (Day of Week) in month, 2="2nd (Day of Week) in month", etc.)
  2. If you are looking for the LAST occurrence of the Day of Week in the month, then set lngOccurrence to 0

datMonth--Date containing the Month and Year to find the dates required. Note that although a day is required (as part of the date passed), it is not used within the function itself

Finally, there is an optional argument: blnIsInMonth. This is an internal argument return that indicates whether the date returned is the same as the date originally passed. If months are the same, then the return value for blnIsInMonth is True, otherwise, the answer is False.

The reason for this boolean argument is that the function will always return a date. If the desired result is to find, say, the 5th Monday in January 2008, the return is actually February 4 2008. Since the months do not match, however, blnIsInMonth would return false. This will allow you to write code from the calling function to warn the user, i.e. "There are not 5 occurences of Monday in January 2008".

Here is the function:

Code:
Public Function fncReturnDate( _
      ByVal lngWeekday As Long, _
      ByVal lngOccurrence As Long, _
      ByVal datMonth As Date, _
      Optional ByRef blnIsInMonth As Boolean) As Date
'-----------------------------------------------------------------------------------------
' Procedure : fncReturnDate
' Created   : 1/10/2008 17:34
' Reference : fncReturnDate*
' Author    : Michael Reese
' Input(s)  : lngWeekday--The Day of Week needed for the return, in number format.
'           :    (i.e. Sun=1, Mon=2, ...Sat=7) (HINT: Use VB Constants to clarify code)
'           :    (i.e. vbSunday=1, vbMonday=2,...vbSaturday=7)
'           : lngOccurrence--What occurence of the Day of Week in the month to use
'           :    (i.e. 1="First (Day of Week) in month, 2="2nd (Day of Week) in month", etc.
'           : ****** OR ******
'           :    If lngOccurrence = 0, then the function will return the date of LAST
'           :    particular Day of week in the month
'           : datMonth--Date containing the Month and Year to find the dates required
'           :    Note: Although a day is required, it is not used in the calculation
'           : blnIsInMonth (optional)--Returns true if month of datMonth is the same as the return
' Output(s) : Function returns the date of the particular day
'           : blnIsInMonth--True if month of date returned is same as month of datMonth
' Purpose   : Returns the date of a particular day in a given month
'           : i.e. Second Wednesday in Dec 2007 returns "December 12 2007" (in date format)
'-----------------------------------------------------------------------------------------

'|<------ 90-character width -------------------------------- 90-character width ------->|

PROC_DECLARATIONS:
   Dim datReturnDate    As Date
   Dim datFirstDay      As Date
   Dim datLastDay       As Date
   Dim lngFirstWeekday  As Long
   Dim lngReturnDay     As Long
   
PROC_START:
   On Error GoTo PROC_ERROR
   
PROC_MAIN:
   If lngOccurrence > 0 Then
      'find the Nth (Day of Week) of the Month
      datFirstDay = DateSerial(Year(datMonth), Month(datMonth), 1)
      lngReturnDay = ((7 * ((lngOccurrence - 1) + Abs(lngWeekday < Weekday(datFirstDay)))) + _
            (lngWeekday - Weekday(datFirstDay)) + 1)
   Else
      'find the last (Day of Week) of the Month
      datLastDay = DateSerial(Year(datMonth), Month(datMonth) + 1, 0)
      lngReturnDay = (Day(datLastDay) - (Weekday(datLastDay) - lngWeekday)) + _
            (7 * (lngWeekday > Weekday(datLastDay)))
   End If
   
   datReturnDate = DateSerial(Year(datMonth), Month(datMonth), lngReturnDay)
   
   'internal return argument blnIsInMonth
   If Month(datReturnDate) = Month(datMonth) Then
      blnIsInMonth = True
   End If
   
PROC_EXIT:
   fncReturnDate = datReturnDate
   Exit Function

PROC_ERROR:
   MsgBox "Error " & Err.Number & " (" & _
           Err.Description & ")" & vbCrLf & vbCrLf & _
           "Procedure: fncReturnDate" & vbCrLf & _
           "Module: basUtilities"
   GoTo PROC_EXIT
      
End Function
 
Status
Not open for further replies.

Users who are viewing this thread

Top Bottom