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.
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:
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.
- 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.)
- 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