G
Guest
Does anyone have a suggestion how to calculate dates without counting
Saturday, Sunday, and possibly Holidays?
Saturday, Sunday, and possibly Holidays?
You are using an out of date browser. It may not display this or other websites correctly.
You should upgrade or use an alternative browser.
You should upgrade or use an alternative browser.
A
Arvin Meyer [MVP]
rwchristian said:Does anyone have a suggestion how to calculate dates without counting
Saturday, Sunday, and possibly Holidays?
http://www.mvps.org/access/datetime/date0012.htm
or possibly:
http://www.datastrat.com/Code/GetBusinessDay.txt
--
Arvin Meyer, MCP, MVP
Microsoft Access
Free Access downloads
http://www.datastrat.com
http://www.mvps.org/access
A
Arvin Meyer [MVP]
rwchristian said:Does anyone have a suggestion how to calculate dates without counting
Saturday, Sunday, and possibly Holidays?
http://www.mvps.org/access/datetime/date0012.htm
or possibly:
http://www.datastrat.com/Code/GetBusinessDay.txt
--
Arvin Meyer, MCP, MVP
Microsoft Access
Free Access downloads
http://www.datastrat.com
http://www.mvps.org/access
J
Jamie Collins
rwchristian said:Does anyone have a suggestion how to calculate dates without counting
Saturday, Sunday, and possibly Holidays?
A standard trick is to use an auxillary calandar table:
http://www.aspfaq.com/show.asp?id=2519
Jamie.
--
J
Jamie Collins
rwchristian said:Does anyone have a suggestion how to calculate dates without counting
Saturday, Sunday, and possibly Holidays?
A standard trick is to use an auxillary calandar table:
http://www.aspfaq.com/show.asp?id=2519
Jamie.
--
R
Ron2006
1) Compute the number of working days between two dates:
workdays
=DateDiff("d",[StartDate],[EndDate])-(DateDiff("ww",[StartDate],[EndDate
],7)+DateDiff("ww",[StartDate],[EndDate],1)) + 1
You now have the total number of weekdays between two dates.
2) Create a table of holidays.
write a query that selects all records in that table between the
specified dates and use
holidaycnt= dCount ("[fieldnameinholidaytable]",
"theabovecreatedquery")
Subtract 2 from1 and you have the actual workdays. This presupposes
that first and last day are to both be counted.
workdays
=DateDiff("d",[StartDate],[EndDate])-(DateDiff("ww",[StartDate],[EndDate
],7)+DateDiff("ww",[StartDate],[EndDate],1)) + 1
You now have the total number of weekdays between two dates.
2) Create a table of holidays.
write a query that selects all records in that table between the
specified dates and use
holidaycnt= dCount ("[fieldnameinholidaytable]",
"theabovecreatedquery")
Subtract 2 from1 and you have the actual workdays. This presupposes
that first and last day are to both be counted.
R
Ron2006
1) Compute the number of working days between two dates:
workdays
=DateDiff("d",[StartDate],[EndDate])-(DateDiff("ww",[StartDate],[EndDate
],7)+DateDiff("ww",[StartDate],[EndDate],1)) + 1
You now have the total number of weekdays between two dates.
2) Create a table of holidays.
write a query that selects all records in that table between the
specified dates and use
holidaycnt= dCount ("[fieldnameinholidaytable]",
"theabovecreatedquery")
Subtract 2 from1 and you have the actual workdays. This presupposes
that first and last day are to both be counted.
workdays
=DateDiff("d",[StartDate],[EndDate])-(DateDiff("ww",[StartDate],[EndDate
],7)+DateDiff("ww",[StartDate],[EndDate],1)) + 1
You now have the total number of weekdays between two dates.
2) Create a table of holidays.
write a query that selects all records in that table between the
specified dates and use
holidaycnt= dCount ("[fieldnameinholidaytable]",
"theabovecreatedquery")
Subtract 2 from1 and you have the actual workdays. This presupposes
that first and last day are to both be counted.
J
James A. Fortune
rwchristian said:Does anyone have a suggestion how to calculate dates without counting
Saturday, Sunday, and possibly Holidays?
Here is what I'm currently using for U.S. workdays:
'modDirectDateFunctions-------
Option Compare Database
Option Explicit
Public Function GetChristmas(dtInYear As Date) As Date
GetChristmas = DateSerial(Year(dtInYear), 12, 25)
End Function
Public Function GetColumbus(dtInYear As Date) As Date
'Second Monday in October
GetColumbus = DateSerial(Year(dtInYear), 10, NthXDay(2, vbMonday,
DateSerial(Year(dtInYear), 10, 1)))
End Function
Public Function GetEaster(dtInYear As Date) As Date
Dim d As Integer
Dim y As Integer
Dim DT As Date
y = Year(dtInYear)
d = (19 * (y Mod 19) + 24) Mod 30
DT = DateAdd("d", d, DateSerial(y, 3, 22))
DT = DateAdd("d", (8 - WeekDay(DT)) Mod 7, DT)
GetEaster = DateSerial(Year(dtInYear), Month(DT), Day(DT))
End Function
Public Function GetIndependence(dtInYear As Date) As Date
GetIndependence = DateSerial(Year(dtInYear), 7, 4)
End Function
Public Function GetLabor(dtInYear As Date) As Date
'First Monday in September
GetLabor = DateSerial(Year(dtInYear), 9, NthXDay(1, vbMonday,
DateSerial(Year(dtInYear), 9, 1)))
End Function
Public Function GetMartinLutherKing(dtInYear As Date) As Date
'Third Monday in January
GetMartinLutherKing = DateSerial(Year(dtInYear), 1, NthXDay(3, vbMonday,
DateSerial(Year(dtInYear), 1, 1)))
End Function
Public Function GetMemorial(dtInYear As Date) As Date
'Last Monday in May
GetMemorial = DateSerial(Year(dtInYear), 5,
Day(LastXDay(DateSerial(Year(dtInYear), 5, 1), vbMonday)))
End Function
Public Function GetNewYears(dtInYear As Date) As Date
GetNewYears = DateSerial(Year(dtInYear), 1, 1)
End Function
Public Function GetPresidents(dtInYear As Date) As Date
'Third Monday in February
GetPresidents = DateSerial(Year(dtInYear), 2, NthXDay(3, vbMonday,
DateSerial(Year(dtInYear), 2, 1)))
End Function
Public Function GetThanksgiving(dtInYear As Date) As Date
'Fourth Thursday in November
GetThanksgiving = DateSerial(Year(dtInYear), 11, NthXDay(4, vbThursday,
DateSerial(Year(dtInYear), 11, 1)))
End Function
Public Function GetVeterans(dtInYear As Date) As Date
GetVeterans = DateSerial(Year(dtInYear), 11, 11)
End Function
Public Function LastXDay(dtD As Date, DayConst As Integer) As Date
LastXDay = DateSerial(Year(dtD), Month(dtD) + 1,
(-WeekDay(DateSerial(Year(dtD), Month(dtD) + 1, 0)) + DayConst - 7) Mod 7)
End Function
Public Function NthXDay(N As Integer, d As Integer, dtD As Date) As Integer
NthXDay = (7 - WeekDay(DateSerial(Year(dtD), Month(dtD), 1)) + d) Mod 7
+ 1 + (N - 1) * 7
End Function
Public Function CountHolidays(dtStart As Date, dtEnd As Date)
Dim lngTemp As Long
lngTemp = 0
lngTemp = lngTemp + Abs(GetNewYearsObserved(dtStart) >= dtStart) +
Abs(GetNewYearsObserved(dtEnd) <= dtEnd) + Year(dtEnd) - Year(dtStart) - 1
lngTemp = lngTemp + Abs(GetMartinLutherKing(dtStart) >= dtStart) +
Abs(GetMartinLutherKing(dtEnd) <= dtEnd) + Year(dtEnd) - Year(dtStart) - 1
lngTemp = lngTemp + Abs(GetPresidents(dtStart) >= dtStart) +
Abs(GetPresidents(dtEnd) <= dtEnd) + Year(dtEnd) - Year(dtStart) - 1
'lngTemp = lngTemp + Abs(GetEasterMonday(dtStart) >= dtStart) +
Abs(GetEasterMonday(dtEnd) <= dtEnd) + Year(dtEnd) - Year(dtStart) - 1
lngTemp = lngTemp + Abs(GetMemorial(dtStart) >= dtStart) +
Abs(GetMemorial(dtEnd) <= dtEnd) + Year(dtEnd) - Year(dtStart) - 1
lngTemp = lngTemp + Abs(GetIndependenceObserved(dtStart) >= dtStart) +
Abs(GetIndependenceObserved(dtEnd) <= dtEnd) + Year(dtEnd) -
Year(dtStart) - 1
lngTemp = lngTemp + Abs(GetLabor(dtStart) >= dtStart) +
Abs(GetLabor(dtEnd) <= dtEnd) + Year(dtEnd) - Year(dtStart) - 1
lngTemp = lngTemp + Abs(GetColumbus(dtStart) >= dtStart) +
Abs(GetColumbus(dtEnd) <= dtEnd) + Year(dtEnd) - Year(dtStart) - 1
lngTemp = lngTemp + Abs(GetVeteransObserved(dtStart) >= dtStart) +
Abs(GetVeteransObserved(dtEnd) <= dtEnd) + Year(dtEnd) - Year(dtStart) - 1
lngTemp = lngTemp + Abs(GetThanksgiving(dtStart) >= dtStart) +
Abs(GetThanksgiving(dtEnd) <= dtEnd) + Year(dtEnd) - Year(dtStart) - 1
lngTemp = lngTemp + Abs(GetChristmasObserved(dtStart) >= dtStart) +
Abs(GetChristmasObserved(dtEnd) <= dtEnd) + Year(dtEnd) - Year(dtStart) - 1
If lngTemp < 0 Then lngTemp = 0
CountHolidays = lngTemp
End Function
Public Function CountWeekdays(dtStart As Date, dtEnd As Date) As Integer
CountWeekdays = DateDiff("d", dtStart, dtEnd) + 1 -
CountWeekendDays(dtStart, dtEnd)
End Function
Public Function CountWeekendDays(dtStart As Date, dtEnd As Date) As Integer
Dim intSat As Integer
Dim intSun As Integer
'This function assumes dtStart <= dtEnd
CountWeekendDays = 0
'intSat = (LEDay(dtEnd, 7) - GEDay(dtStart, 7)) / 7 + 1
intSat = DateDiff("d", GEDay(dtStart, 7), LEDay(dtEnd, 7)) / 7 + 1
'intSun = (LEDay(dtEnd, 1) - GEDay(dtStart, 1)) / 7 + 1
intSun = DateDiff("d", GEDay(dtStart, 1), LEDay(dtEnd, 1)) / 7 + 1
'CountWeekendDays = (intSat + intSun + Abs(intSat) + Abs(intSun)) / 2
CountWeekendDays = Ramp(intSat) + Ramp(intSun)
End Function
Public Function CountWorkdays(dtStart As Date, dtEnd As Date) As Integer
'Note: using observed holidays precludes holidays falling on a weekend.
CountWorkdays = CountWeekdays(dtStart, dtEnd) - CountHolidays(dtStart,
dtEnd)
End Function
Public Function LEDay(dtX As Date, vbDay As Integer) As Date
LEDay = DateAdd("d", -(7 + WeekDay(dtX) - vbDay) Mod 7, dtX)
End Function
Public Function GEDay(dtX As Date, vbDay As Integer) As Date
GEDay = DateAdd("d", (7 + vbDay - WeekDay(dtX)) Mod 7, dtX)
End Function
Public Function GetEasterMonday(dtInYear As Date) As Date
GetEasterMonday = DateAdd("d", 1, GetEaster(dtInYear))
End Function
Public Function GetIndependenceObserved(dtInYear As Date) As Date
Dim dtTemp As Date
dtTemp = DateSerial(Year(dtInYear), 7, 4)
If WeekDay(dtTemp) = 7 Then dtTemp = DateAdd("d", -1, dtTemp)
If WeekDay(dtTemp) = 1 Then dtTemp = DateAdd("d", 1, dtTemp)
GetIndependenceObserved = dtTemp
End Function
Public Function GetChristmasObserved(dtInYear As Date) As Date
Dim dtTemp As Date
dtTemp = DateSerial(Year(dtInYear), 12, 25)
If WeekDay(dtTemp) = 7 Then dtTemp = DateAdd("d", -1, dtTemp)
If WeekDay(dtTemp) = 1 Then dtTemp = DateAdd("d", 1, dtTemp)
GetChristmasObserved = dtTemp
End Function
Public Function GetNewYearsObserved(dtInYear As Date) As Date
Dim dtTemp As Date
dtTemp = DateSerial(Year(dtInYear), 1, 1)
If WeekDay(dtTemp) = 7 Then dtTemp = DateAdd("d", 2, dtTemp)
If WeekDay(dtTemp) = 1 Then dtTemp = DateAdd("d", 1, dtTemp)
GetNewYearsObserved = dtTemp
End Function
Public Function GetVeteransObserved(dtInYear As Date) As Date
Dim dtTemp As Date
dtTemp = DateSerial(Year(dtInYear), 11, 11)
If WeekDay(dtTemp) = 7 Then dtTemp = DateAdd("d", -1, dtTemp)
If WeekDay(dtTemp) = 1 Then dtTemp = DateAdd("d", 1, dtTemp)
GetVeteransObserved = dtTemp
End Function
Public Function Ramp(varX As Variant) As Variant
Ramp = IIf(Nz(varX, 0) >= 0, Nz(varX, 0), 0)
End Function
'end--modDirectDateFunctions-------
The function CountWorkdays will count weekdays that do not fall on an
observed U.S. holiday date. These functions can also be used to build a
U.S. holiday table. Any unwanted holidays can be commented out in the
CountHolidays function. Watch out for line wrap.
James A. Fortune
(e-mail address removed)
J
James A. Fortune
rwchristian said:Does anyone have a suggestion how to calculate dates without counting
Saturday, Sunday, and possibly Holidays?
Here is what I'm currently using for U.S. workdays:
'modDirectDateFunctions-------
Option Compare Database
Option Explicit
Public Function GetChristmas(dtInYear As Date) As Date
GetChristmas = DateSerial(Year(dtInYear), 12, 25)
End Function
Public Function GetColumbus(dtInYear As Date) As Date
'Second Monday in October
GetColumbus = DateSerial(Year(dtInYear), 10, NthXDay(2, vbMonday,
DateSerial(Year(dtInYear), 10, 1)))
End Function
Public Function GetEaster(dtInYear As Date) As Date
Dim d As Integer
Dim y As Integer
Dim DT As Date
y = Year(dtInYear)
d = (19 * (y Mod 19) + 24) Mod 30
DT = DateAdd("d", d, DateSerial(y, 3, 22))
DT = DateAdd("d", (8 - WeekDay(DT)) Mod 7, DT)
GetEaster = DateSerial(Year(dtInYear), Month(DT), Day(DT))
End Function
Public Function GetIndependence(dtInYear As Date) As Date
GetIndependence = DateSerial(Year(dtInYear), 7, 4)
End Function
Public Function GetLabor(dtInYear As Date) As Date
'First Monday in September
GetLabor = DateSerial(Year(dtInYear), 9, NthXDay(1, vbMonday,
DateSerial(Year(dtInYear), 9, 1)))
End Function
Public Function GetMartinLutherKing(dtInYear As Date) As Date
'Third Monday in January
GetMartinLutherKing = DateSerial(Year(dtInYear), 1, NthXDay(3, vbMonday,
DateSerial(Year(dtInYear), 1, 1)))
End Function
Public Function GetMemorial(dtInYear As Date) As Date
'Last Monday in May
GetMemorial = DateSerial(Year(dtInYear), 5,
Day(LastXDay(DateSerial(Year(dtInYear), 5, 1), vbMonday)))
End Function
Public Function GetNewYears(dtInYear As Date) As Date
GetNewYears = DateSerial(Year(dtInYear), 1, 1)
End Function
Public Function GetPresidents(dtInYear As Date) As Date
'Third Monday in February
GetPresidents = DateSerial(Year(dtInYear), 2, NthXDay(3, vbMonday,
DateSerial(Year(dtInYear), 2, 1)))
End Function
Public Function GetThanksgiving(dtInYear As Date) As Date
'Fourth Thursday in November
GetThanksgiving = DateSerial(Year(dtInYear), 11, NthXDay(4, vbThursday,
DateSerial(Year(dtInYear), 11, 1)))
End Function
Public Function GetVeterans(dtInYear As Date) As Date
GetVeterans = DateSerial(Year(dtInYear), 11, 11)
End Function
Public Function LastXDay(dtD As Date, DayConst As Integer) As Date
LastXDay = DateSerial(Year(dtD), Month(dtD) + 1,
(-WeekDay(DateSerial(Year(dtD), Month(dtD) + 1, 0)) + DayConst - 7) Mod 7)
End Function
Public Function NthXDay(N As Integer, d As Integer, dtD As Date) As Integer
NthXDay = (7 - WeekDay(DateSerial(Year(dtD), Month(dtD), 1)) + d) Mod 7
+ 1 + (N - 1) * 7
End Function
Public Function CountHolidays(dtStart As Date, dtEnd As Date)
Dim lngTemp As Long
lngTemp = 0
lngTemp = lngTemp + Abs(GetNewYearsObserved(dtStart) >= dtStart) +
Abs(GetNewYearsObserved(dtEnd) <= dtEnd) + Year(dtEnd) - Year(dtStart) - 1
lngTemp = lngTemp + Abs(GetMartinLutherKing(dtStart) >= dtStart) +
Abs(GetMartinLutherKing(dtEnd) <= dtEnd) + Year(dtEnd) - Year(dtStart) - 1
lngTemp = lngTemp + Abs(GetPresidents(dtStart) >= dtStart) +
Abs(GetPresidents(dtEnd) <= dtEnd) + Year(dtEnd) - Year(dtStart) - 1
'lngTemp = lngTemp + Abs(GetEasterMonday(dtStart) >= dtStart) +
Abs(GetEasterMonday(dtEnd) <= dtEnd) + Year(dtEnd) - Year(dtStart) - 1
lngTemp = lngTemp + Abs(GetMemorial(dtStart) >= dtStart) +
Abs(GetMemorial(dtEnd) <= dtEnd) + Year(dtEnd) - Year(dtStart) - 1
lngTemp = lngTemp + Abs(GetIndependenceObserved(dtStart) >= dtStart) +
Abs(GetIndependenceObserved(dtEnd) <= dtEnd) + Year(dtEnd) -
Year(dtStart) - 1
lngTemp = lngTemp + Abs(GetLabor(dtStart) >= dtStart) +
Abs(GetLabor(dtEnd) <= dtEnd) + Year(dtEnd) - Year(dtStart) - 1
lngTemp = lngTemp + Abs(GetColumbus(dtStart) >= dtStart) +
Abs(GetColumbus(dtEnd) <= dtEnd) + Year(dtEnd) - Year(dtStart) - 1
lngTemp = lngTemp + Abs(GetVeteransObserved(dtStart) >= dtStart) +
Abs(GetVeteransObserved(dtEnd) <= dtEnd) + Year(dtEnd) - Year(dtStart) - 1
lngTemp = lngTemp + Abs(GetThanksgiving(dtStart) >= dtStart) +
Abs(GetThanksgiving(dtEnd) <= dtEnd) + Year(dtEnd) - Year(dtStart) - 1
lngTemp = lngTemp + Abs(GetChristmasObserved(dtStart) >= dtStart) +
Abs(GetChristmasObserved(dtEnd) <= dtEnd) + Year(dtEnd) - Year(dtStart) - 1
If lngTemp < 0 Then lngTemp = 0
CountHolidays = lngTemp
End Function
Public Function CountWeekdays(dtStart As Date, dtEnd As Date) As Integer
CountWeekdays = DateDiff("d", dtStart, dtEnd) + 1 -
CountWeekendDays(dtStart, dtEnd)
End Function
Public Function CountWeekendDays(dtStart As Date, dtEnd As Date) As Integer
Dim intSat As Integer
Dim intSun As Integer
'This function assumes dtStart <= dtEnd
CountWeekendDays = 0
'intSat = (LEDay(dtEnd, 7) - GEDay(dtStart, 7)) / 7 + 1
intSat = DateDiff("d", GEDay(dtStart, 7), LEDay(dtEnd, 7)) / 7 + 1
'intSun = (LEDay(dtEnd, 1) - GEDay(dtStart, 1)) / 7 + 1
intSun = DateDiff("d", GEDay(dtStart, 1), LEDay(dtEnd, 1)) / 7 + 1
'CountWeekendDays = (intSat + intSun + Abs(intSat) + Abs(intSun)) / 2
CountWeekendDays = Ramp(intSat) + Ramp(intSun)
End Function
Public Function CountWorkdays(dtStart As Date, dtEnd As Date) As Integer
'Note: using observed holidays precludes holidays falling on a weekend.
CountWorkdays = CountWeekdays(dtStart, dtEnd) - CountHolidays(dtStart,
dtEnd)
End Function
Public Function LEDay(dtX As Date, vbDay As Integer) As Date
LEDay = DateAdd("d", -(7 + WeekDay(dtX) - vbDay) Mod 7, dtX)
End Function
Public Function GEDay(dtX As Date, vbDay As Integer) As Date
GEDay = DateAdd("d", (7 + vbDay - WeekDay(dtX)) Mod 7, dtX)
End Function
Public Function GetEasterMonday(dtInYear As Date) As Date
GetEasterMonday = DateAdd("d", 1, GetEaster(dtInYear))
End Function
Public Function GetIndependenceObserved(dtInYear As Date) As Date
Dim dtTemp As Date
dtTemp = DateSerial(Year(dtInYear), 7, 4)
If WeekDay(dtTemp) = 7 Then dtTemp = DateAdd("d", -1, dtTemp)
If WeekDay(dtTemp) = 1 Then dtTemp = DateAdd("d", 1, dtTemp)
GetIndependenceObserved = dtTemp
End Function
Public Function GetChristmasObserved(dtInYear As Date) As Date
Dim dtTemp As Date
dtTemp = DateSerial(Year(dtInYear), 12, 25)
If WeekDay(dtTemp) = 7 Then dtTemp = DateAdd("d", -1, dtTemp)
If WeekDay(dtTemp) = 1 Then dtTemp = DateAdd("d", 1, dtTemp)
GetChristmasObserved = dtTemp
End Function
Public Function GetNewYearsObserved(dtInYear As Date) As Date
Dim dtTemp As Date
dtTemp = DateSerial(Year(dtInYear), 1, 1)
If WeekDay(dtTemp) = 7 Then dtTemp = DateAdd("d", 2, dtTemp)
If WeekDay(dtTemp) = 1 Then dtTemp = DateAdd("d", 1, dtTemp)
GetNewYearsObserved = dtTemp
End Function
Public Function GetVeteransObserved(dtInYear As Date) As Date
Dim dtTemp As Date
dtTemp = DateSerial(Year(dtInYear), 11, 11)
If WeekDay(dtTemp) = 7 Then dtTemp = DateAdd("d", -1, dtTemp)
If WeekDay(dtTemp) = 1 Then dtTemp = DateAdd("d", 1, dtTemp)
GetVeteransObserved = dtTemp
End Function
Public Function Ramp(varX As Variant) As Variant
Ramp = IIf(Nz(varX, 0) >= 0, Nz(varX, 0), 0)
End Function
'end--modDirectDateFunctions-------
The function CountWorkdays will count weekdays that do not fall on an
observed U.S. holiday date. These functions can also be used to build a
U.S. holiday table. Any unwanted holidays can be commented out in the
CountHolidays function. Watch out for line wrap.
James A. Fortune
(e-mail address removed)