Welcome Guest ( Log In | Register )

 @import url(https://www.google.com/cse/api/branding.css); Custom Search
Menu
Content
Resources
To Do
Toolbox

Advertisment

 NthDowInMonthVBA

Synopsis

Determine the date of the Nth occurrence of a weekday in a given month.

CODE
' NthDowInMonthVBA
' http://www.utteraccess.com/wiki/NthDowInMonthVBA
' Code courtesy of UtterAccess Wiki
' Licensed under Creative Commons License
' http://creativecommons.org/licenses/by-sa/3.0/
'
' You are free to use this code in any application,
' provided this notice is left unchanged.
'
' rev  date                          brief descripton
' 1.0  2015-11-02
'
'NthDowInMonthVBA ******************************************************
'  Calculates a date depending on the DOW, eg 3rd Friday in Jun
' ARGUMENTS
'  Yr (long) the desired year
'  Mo (long) the desired month
'  Nth (Long)  1 (or &lt; 1) = 1st, 2= 2nd, 3=3rd, 4=4th, 5 (or &gt;4) =Last
'     Nth is given by the gdNth enumeration: gdFirst, gdSecond, gdThird,
'        gdFourth, gdLast
'  Dow  - the Visual Basic Constant for the dow, e.g. vbSundy
'     Uses vb's vbDayOfWeek enumeration
' RETURNS
'     a Date that is the Nth Day of Week In the Month (e.g. First Thursday,
'        Last Monday, etc
' ASSUMES
'  Access default firstdayofweek (vbSunday=1)
Function NthDowInMonthVBA(yr As Long, mo As Long, Nth As Long, _
dow As Long) As Date
Dim fDate As Date, yDate As Date, zDate As Date, days As Long, zNth As Long
'verify Nth is valid, adjust if not
zNth = IIf(Nth &lt; 1, 1, IIf(Nth &gt; 5, 5, Nth))
'1st day of the month
fDate = DateSerial(yr, mo, 1)
'last day in month
yDate = DateAdd("m", 1, fDate) - 1
'calculate days to first weekday in month
days = dow - Weekday(fDate)
'negative days points to previous month, increment by 7
If (days &lt; 0) Then days = days + 7
'tentative return date
zDate = fDate + days + (zNth - 1) * 7
'decr by 7 if date in next month (adjusts for Last dow)
If zDate &gt; yDate Then zDate = zDate - 7
'the return value
NthDowInMonthVBA = zDate
End Function

NthDowInMonthVBA by UtterAccess Wiki is licensed under a Creative Commons Attribution-ShareAlike 3.0 Unported License.
Editing and revision of the content is freely encouraged; for details, see Expected Usage.

 @import url(https://www.google.com/cse/api/branding.css); Custom Search

 This page has been accessed 1,680 times.  This page was last modified 11:19, 2 November 2015 by azolder.   Disclaimers