Solved: Calculate Business Hours

Are you doing this in VBA or a Query?

Just check the site:
www.mvps.org/access

There's a piece of sample code and much more!

Nic;o)

The following code (which probably originated from www.mvps.org/access) will do everything you want. It relies on the existence of a table (you control tablename/fieldnames yourself) which contains the holidays that are applicable to your area/country, which you can populate. (The code to do this is part of what is posted below - alter the dates/descriptions to reflect what is in your country). At www.mvps.org/access the code below was spread acrios a couple of examples but I had brought it all back into one module for my own purposes.

Required table layout is as follows: (remember the names can be whatever you like, you pass these as paramters to appropriate functions below)

Table: tbl_Holidays

Fields: HolidayDate Short Date Primary Key
HolidayDayName Text (3)
HolidayName Text (50)

Complete code:

Option Compare Database
Option Explicit

Function HolidayTableFill_TSB(strHolidayTbl As String, strHolidayDate As String, _
strHolidayDay As String, strHolidayName As String, intFirstYear As Integer, intLastYear As Integer)

' Comments : Add holiday dates to a holiday table
' Assumes table already exists and does not include the dates being added.
' Parameters: strHolidayTbl - name of holiday table
' strHolidayDate - field name of holiday dates in the holiday table
' strHolidayDay - field name of holiday day name in the holiday table
' strHolidayName - field name of description field (optional)
' intFirstYear - first year
' intLastYear - last year
'
Dim db As Database
Dim rstHoliday As Recordset
Dim intYear As Integer
Dim datHoliday As Date

Set db = DBEngine(0)(0)
Set rstHoliday = db.OpenRecordset(strHolidayTbl)

For intYear = intFirstYear To intLastYear

' New Year's Day (January 1)
datHoliday = HolidayDate_TSB(CDate("1/1/" & intYear))
Call HolidayTblWrite_TSB(datHoliday, rstHoliday, strHolidayDate, strHolidayDay, strHolidayName, "New Year's Day")

' Australia Day (January 26)
datHoliday = HolidayDate_TSB(CDate("26/1/" & intYear))
Call HolidayTblWrite_TSB(datHoliday, rstHoliday, strHolidayDate, strHolidayDay, strHolidayName, "Australia Day")

' Anzac Day (April 25)
datHoliday = HolidayDate_TSB(CDate("25/4/" & intYear))
Call HolidayTblWrite_TSB(datHoliday, rstHoliday, strHolidayDate, strHolidayDay, strHolidayName, "Anzac Day")

' Queens's Birthday (2rd Monday in June)
datHoliday = NthDayOfMonth_TSB(6, intYear, 2, 2)
Call HolidayTblWrite_TSB(datHoliday, rstHoliday, strHolidayDate, strHolidayDay, strHolidayName, "Queens's Birthday")

' Labour Day (1st Monday in October)
datHoliday = NthDayOfMonth_TSB(10, intYear, 1, 2)
Call HolidayTblWrite_TSB(datHoliday, rstHoliday, strHolidayDate, strHolidayDay, strHolidayName, "Labour Day")

' Christmas (December 25)
datHoliday = HolidayDate_TSB(CDate("25/12/" & intYear))
Call HolidayTblWrite_TSB(datHoliday, rstHoliday, strHolidayDate, strHolidayDay, strHolidayName, "Christmas")

' Boxing Day (December 26)
datHoliday = HolidayDate_TSB(CDate("26/12/" & intYear))
Call HolidayTblWrite_TSB(datHoliday, rstHoliday, strHolidayDate, strHolidayDay, strHolidayName, "Boxing Day")

Next intYear

rstHoliday.Close
db.Close

End Function

Function HolidayDate_TSB(datDay As Date) As Date
' Comments : For fixed date holidays (New Year's, 4th of July, Christmas),
' returns the celebrated date based on Federal guidelines
' Saturday & Sunday dates are shifted to Monday.
' Parameters: datDay - date to calculate
' Returns : Adjusted holiday date
'
Dim datHoliday As Date

datHoliday = CDate(datDay)
Select Case WeekDay(datDay)
Case 1: datHoliday = datHoliday + 1 ' Shift Sunday to Monday
Case 7: datHoliday = datHoliday + 2 ' Shift Saturday to Monday
End Select

HolidayDate_TSB = datHoliday

End Function

Function NthDayOfMonth_TSB(intMonth As Integer, intYear As Integer, _
intOccurrence As Integer, intDay As Integer) As Variant

' Comments : Returns the date of the Nth day (Monday, Tuesday, etc.) of the month
' Parameters: intMonth - month to check
' intYear - year to check
' intOccurrence - the occurrence number of the day to calculate
' (1 for first, 2 for second, etc.)
' intDay - the day of the week to calculate (1 for Sunday, 2 for Monday, etc.)
' Returns : Nth day of month (null if date does not exist)
'
Dim varTempDate As Variant
Dim intCurrDay As Integer

varTempDate = DateSerial(intYear, intMonth, 1)

If (intDay > 0) And (intDay < 8) And (intOccurrence > 0) Then
' Calculate first intDay of the month.
intCurrDay = WeekDay(varTempDate)
If intCurrDay <> intDay Then
If intCurrDay < intDay Then
varTempDate = varTempDate + (intDay - intCurrDay)
Else
varTempDate = varTempDate + (7 + intDay - intCurrDay)
End If
End If
If intOccurrence > 1 Then
varTempDate = varTempDate + 7 * (intOccurrence - 1)
If Month(varTempDate) <> intMonth Then ' Date goes past month
varTempDate = Null
End If
End If
Else
varTempDate = Null
End If

NthDayOfMonth_TSB = varTempDate

End Function

Function HolidayTblWrite_TSB(datHoliday As Date, rsHoliday As Recordset, _
strHolidayDate As String, strHolidayDay As String, strHolidayName As String, strDescription As String)

' Comments : Add a record to the holiday table
' Used in an example of filling the holiday table
' Parameters: datHoliday - holiday date to add
' rsHoliday - recordset pointing to the holiday table
' strHolidayDate - field name to put the holiday date
' strHolidayDay - field name to put the (abbreviated) day name for the holiday
' strHolidayName - field name to enter description (optional)
' NOTE: Does not check to see if the date is already in the table.
'
Dim DayOfWeek As String * 3

rsHoliday.AddNew
rsHoliday(strHolidayDate) = datHoliday
If strHolidayDay <> "" Then
Select Case WeekDay(datHoliday)
Case 1
DayOfWeek = "Sun"
Case 2
DayOfWeek = "Mon"
Case 3
DayOfWeek = "Tue"
Case 4
DayOfWeek = "Wed"
Case 5
DayOfWeek = "Thu"
Case 6
DayOfWeek = "Fri"
Case 7
DayOfWeek = "Sat"
End Select
rsHoliday(strHolidayDay) = DayOfWeek
End If
If strHolidayName <> "" Then
rsHoliday(strHolidayName) = strDescription
End If
rsHoliday.Update

End Function

Function DiffBusinessDays_TSB(datDay1 As Date, datDay2 As Date, _
strHolidayTbl As String, strHolidayDate As String) As Long

' Comments : Returns the number of business days between two dates
' The days are rounded down -- it takes 24 hours to make a day.
' Weekend dates (Saturday and Sunday) and holidays are not counted.
' Parameters: datDay1 - first (earlier) date/time (subtracted from datDay2)
' datDay2 - second (later) date/time
' strHolidayTbl - name of holiday table
' strHolidayDate - field name of holiday dates in the holiday table
' Returns : Number of whole business days between two dates
' (Returns negative days if datDay1 is after datDay2)

Dim db As Database
Dim rst As Recordset

Dim strSQL As String, strField As String
Dim lngBusinessDays As Long, lngWeekdays As Long

Dim StartDate As Date, EndDate As Date

lngWeekdays = DiffWeekDays_TSB(datDay1, datDay2)

StartDate = Format(datDay1, "yy/mm/dd")
EndDate = Format(datDay2, "yy/mm/dd")

Set db = DBEngine(0)(0)

strField = "format([" & strHolidayTbl & "].[" & strHolidayDate & "],""yy/mm/dd"")"

strSQL = "SELECT DISTINCTROW Count(" & strField & ") AS Count" & _
" FROM [" & strHolidayTbl & "]" & _
" WHERE ((" & strField

If datDay1 <= datDay2 Then
strSQL = strSQL & ">=#" & datDay1 & "# And " & _
strField & "<#" & datDay2 & "#));"
Else
strSQL = strSQL & ">=#" & datDay2 & "# And " & _
strField & "<#" & datDay1 & "#));"
End If

Set rst = db.OpenRecordset(strSQL)
lngBusinessDays = rst![Count]
rst.Close
db.Close

' MsgBox "Number of weekdays = " & lngWeekdays
' MsgBox "Number of holidays = " & lngBusinessDays
' MsgBox "Number of business days = " & (lngWeekdays - lngBusinessDays)

DiffBusinessDays_TSB = lngWeekdays - lngBusinessDays

End Function
Public Function DiffWeekDays_TSB(datDay1 As Date, datDay2 As Date) As Long

' Comments : Returns the number of business days between two dates
' Weekend dates (Saturday and Sunday) are not counted.
' Parameters: datDay1 - first (earlier) date/time (subtracted from datDay2)
' datDay2 - second (later) date/time
' Returns : Number of whole business days between two dates
' (Returns negative days if datDay1 is after datDay2)

Dim lngWeekdays As Long

Dim StartDate As Date, EndDate As Date

lngWeekdays = 0
StartDate = Format(datDay1, "Short Date")
EndDate = Format(datDay2, "Short Date")

Do Until StartDate > EndDate
If WeekDay(StartDate) <> 1 And WeekDay(StartDate) <> 7 Then
lngWeekdays = lngWeekdays + 1
End If
StartDate = Format(DateAdd("d", 1, StartDate), "Short Date")
Loop

DiffWeekDays_TSB = lngWeekdays

End Function

VMcBain

ASKER

Archery,

I don't see in your code a way to handle the time issue. I need it to only include the time between 8:30 am and 7:00 pm. I need Business HOURS not business days.

Thanks!

Valerie

VMcBain

ASKER

Archery,

Your Holiday Code worked Great! after I modified it for US holiday's. The only tricky part was getting the LAST thursday in november and the last monday in september. Which turned out to be a simple calculation. The only function that I modified is the following:

Function HolidayTableFill_TSB(strHolidayTbl As String, strHolidayDate As String, _
strHolidayDay As String, strHolidayName As String, intFirstYear As Integer, intLastYear As Integer)

' Comments : Add holiday dates to a holiday table
' Assumes table already exists and does not include the dates being added.
' Parameters: strHolidayTbl - name of holiday table
' strHolidayDate - field name of holiday dates in the holiday table
' strHolidayDay - field name of holiday day name in the holiday table
' strHolidayName - field name of description field (optional)
' intFirstYear - first year
' intLastYear - last year
'
Dim db As Database
Dim rstHoliday As Recordset
Dim intYear As Integer
Dim datHoliday As Date

Set db = DBEngine(0)(0)
Set rstHoliday = db.OpenRecordset(strHolidayTbl)

For intYear = intFirstYear To intLastYear

' New Year's Day (January 1)
datHoliday = HolidayDate_TSB(CDate("1/1/" & intYear))
Call HolidayTblWrite_TSB(datHoliday, rstHoliday, strHolidayDate, strHolidayDay, strHolidayName, "New Year's Day")

' Memorial Day (Last Monday in May)
datHoliday = (NthDayOfMonth_TSB(6, intYear, 1, 2)) - 7
Call HolidayTblWrite_TSB(datHoliday, rstHoliday, strHolidayDate, strHolidayDay, strHolidayName, "Memorial Day")

' Independence Day (July 4)
datHoliday = HolidayDate_TSB(CDate("7/4/" & intYear))
Call HolidayTblWrite_TSB(datHoliday, rstHoliday, strHolidayDate, strHolidayDay, strHolidayName, "Independence Day")

' Labor Day (1st Monday in September)
datHoliday = NthDayOfMonth_TSB(9, intYear, 1, 2)
Call HolidayTblWrite_TSB(datHoliday, rstHoliday, strHolidayDate, strHolidayDay, strHolidayName, "Labor Day")

' Thanksgiving Day (Last Thursday in November)
datHoliday = (NthDayOfMonth_TSB(12, intYear, 1, 5)) - 7
Call HolidayTblWrite_TSB(datHoliday, rstHoliday, strHolidayDate, strHolidayDay, strHolidayName, "Thanksgiving")

' Christmas (December 25)
datHoliday = HolidayDate_TSB(CDate("12/25/" & intYear))
Call HolidayTblWrite_TSB(datHoliday, rstHoliday, strHolidayDate, strHolidayDay, strHolidayName, "Christmas")

Next intYear

rstHoliday.Close
db.Close

End Function

Mike McCracken

A simple correction to your formula.

Thanksgiving is the 4th (not last) Thursday in November.

As far as business hours are concerned I would do somethin like
Day 1 hours are 7PM - Star time
Last Day hours are End TIme - 830AM
Hours in between are
(NumberDays -2) * 10.5

Add those up and you should have business hours.

mlmcc

archery

Valerie,

The nice thing about forums like this is that (at times) it forces you to (re)look at "old" routines that you might have in a different light, and maybe improve them. Your question made me make some existing routines a bit more flexible, and so I carried on with what I believe is the answer to your problem.

Have, however, had to replace some of the previous routines I posted and which (I believe) you picked up.
The replacement/s are below, but (first) some code to use for your complete problem (the final result returned is in MINUTES) :

Function test1()

Dim Start_Date As Date
Dim Start_Time As Date
Dim End_Date As Date
Dim End_Time As Date

Dim Start_DateTime As Date
Dim End_DateTime As Date

Dim RetVar As Variant

' --------------------------------------------------------------
' Alter these to reflect differing "test" results
'

Start_Date = #8/16/02#
Start_Time = #8:45:00 PM#

End_Date = #8/20/02#
End_Time = #7:25:00 AM#

' --------------------------------------------------------------

Start_DateTime = Start_Date & Space(1) & Start_Time
End_DateTime = End_Date & Space(1) & End_Time

RetVar = Valeries_Problem(Start_DateTime, End_DateTime)

MsgBox RetVar & " minutes between dates"

End Function

Public Function Valeries_Problem(Input_Start As Date, _
Input_End As Date) As Long

Const Replacement_MorningTime As Date = #8:30:00 AM#
Const Replacement_EveningTime As Date = #7:00:00 PM#

Dim Start_Time As Date
Dim End_Time As Date

If Format(Input_Start, "Medium Time") < Replacement_MorningTime Then
Start_Time = Format(Input_Start, "Short Date") & Space(1) & Format(Replacement_MorningTime, "Medium Time")
Else
If Format(Input_Start, "Medium Time") > Replacement_EveningTime Then
Start_Time = Format(Input_Start, "Short Date") & Space(1) & Format(Replacement_EveningTime, "Medium Time")
Else
Start_Time = Input_Start
End If
End If

If Format(Input_End, "Medium Time") < Replacement_MorningTime Then
End_Time = Format(Input_End, "Short Date") & Space(1) & Format(Replacement_MorningTime, "Medium time")
Else
If Format(Input_End, "Medium Time") > Replacement_EveningTime Then
End_Time = Format(Input_End, "Short Date") & Space(1) & Format(Replacement_EveningTime, "Medium time")
Else
End_Time = Input_End
End If
End If

Valeries_Problem = glb_GetDiffInMinutes(Start_Time, End_Time)

End Function

' ---------------------------------------------------

Run Test1() to test the routines. You can alter the indicated values to reflect different tests.

In YOUR application you would (eventually) make a call to function "Valeries_Problem" passing it the required dates/times.

' -----------------------------------------------------
'
' Replacement routines (you already have) PLUS some new ones required.
'
'

Public Function glb_GetDiffInMinutes(dat_Start As Date, _
dat_End As Date) As Long

' Calculates the time (in minutes) between two dates.
' The parameters passed as "Date Type" can be - Dates ONLY
' - Dates and Times
'
' Makes calls to existing modules which can (optionally) exclude:
' defined days (normally Sat and Sun (weekends)
' holidays which may fall within the dates
'
' The default for the calls to these existing procedures is:
' Exclude Sat and Sun
' Exclude any dates which are holidays (TRUE)

glb_GetDiffInMinutes = (glb_GetDiffInDate("n", dat_Start, dat_End)) - (DiffBusinessDays_TSB(dat_Start, dat_End) - 1) * (24 * 60)

End Function

Public Function glb_GetDiffInDate(ReqdInterval As String, _
StartDate As Date, _
EndDate As Date) As Long

'Intervals input can be : yyyy Year
' q Quarter
' M Month
' y Day of year
' d Day
' w WeekDay
' ww Week
' H Hour
' N Minute
' S Second

glb_GetDiffInDate = DateDiff(ReqdInterval, StartDate, EndDate)

End Function

Function DiffBusinessDays_TSB(datDay1 As Date, _
datDay2 As Date, _
Optional Excluded_Days As String = "Sat,Sun", _
Optional Exclude_Holidays As Boolean = True, _
Optional strHolidayTbl As String = "tbl_Holidays", _
Optional strHolidayDate As String = "HolidayDate") As Long

' Comments : Returns the number of business days between two dates
' The days are rounded down -- it takes 24 hours to make a day.
' Days defined as "Excluded Days" (normally Saturday and Sunday)
' and holidays are not counted (if requested).
' Parameters: datDay1 - first (earlier) date/time (subtracted from datDay2)
' datDay2 - second (later) date/time
' strHolidayTbl - name of holiday table
' strHolidayDate - field name of holiday dates in the holiday table
' Returns : Number of whole business days between two dates
' (Returns negative days if datDay1 is after datDay2)

Dim db As Database
Dim rst As Recordset

Dim strSQL As String, strField As String
Dim lngBusinessDays As Long, lngWeekdays As Long

Dim StartDate As Date, EndDate As Date

lngWeekdays = DiffWeekDays_TSB(datDay1, datDay2, Excluded_Days)
lngBusinessDays = 0

If Exclude_Holidays = True Then
StartDate = Format(datDay1, "yy/mm/dd")
EndDate = Format(datDay2, "yy/mm/dd")

Set db = DBEngine(0)(0)

strField = "format([" & strHolidayTbl & "].[" & strHolidayDate & "],""yy/mm/dd"")"

strSQL = "SELECT DISTINCTROW Count(" & strField & ") AS Count" & _
" FROM [" & strHolidayTbl & "]" & _
" WHERE ((" & strField

If datDay1 <= datDay2 Then
strSQL = strSQL & ">=#" & datDay1 & "# And " & _
strField & "<#" & datDay2 & "#));"
Else
strSQL = strSQL & ">=#" & datDay2 & "# And " & _
strField & "<#" & datDay1 & "#));"
End If

Set rst = db.OpenRecordset(strSQL)
lngBusinessDays = rst![Count]
rst.Close
db.Close
End If

' MsgBox "Number of weekdays = " & lngWeekdays
' MsgBox "Number of holidays = " & lngBusinessDays
' MsgBox "Number of business days = " & (lngWeekdays - lngBusinessDays)

DiffBusinessDays_TSB = lngWeekdays - lngBusinessDays

End Function
Public Function DiffWeekDays_TSB(datDay1 As Date, _
datDay2 As Date, _
Optional Excluded_Days As String = "Sat,Sun") As Long

' Comments : Returns the number of business days between two dates
' Days 0f the week that are passed as parameters
' (normally Saturday and Sunday are not counted.
' Parameters: datDay1 - first (earlier) date/time (subtracted from datDay2)
' datDay2 - second (later) date/time
' Returns : Number of whole business days between two dates
' (Returns negative days if datDay1 is after datDay2)

Dim lngWeekdays As Long
Dim DayOfWeek As String * 3
Dim StartDate As Date, EndDate As Date

lngWeekdays = 0
StartDate = Format(datDay1, "Short Date")
EndDate = Format(datDay2, "Short Date")

Do Until StartDate > EndDate
Select Case WeekDay(StartDate)
Case 1
DayOfWeek = "Sun"
Case 2
DayOfWeek = "Mon"
Case 3
DayOfWeek = "Tue"
Case 4
DayOfWeek = "Wed"
Case 5
DayOfWeek = "Thu"
Case 6
DayOfWeek = "Fri"
Case 7
DayOfWeek = "Sat"
End Select

If InStr(1, Excluded_Days, DayOfWeek) = 0 Then
lngWeekdays = lngWeekdays + 1
End If
StartDate = Format(DateAdd("d", 1, StartDate), "Short Date")
Loop

DiffWeekDays_TSB = lngWeekdays

End Function

VMcBain

ASKER

mlmcc,

According to my calendar which lists the holidays according to their description, Thanksgiving IS the last thursday in November. However, after looking at November 2001, it has five thursdays, and thanksgiving falls on the 4th one.

Thanks,

Valerie

VMcBain

ASKER

Archery,

Your calculations are not correct.

You are getting the number of minutes total between the two dates, then subtracting the number of business day minutes.
(TotalDaysinMinutes - BusinessDaysinMinutes)

What I want is the following:
(TotalDays - Weekends&Holidays) * 10.5 hours per day.

But I think I can get that from what you gave me!
I'll keep trying.

Thanks,

Valerie

VMcBain

ASKER

But even that is incorrect because it only works when the days are "whole" days, it doesn't take into account partial days.

VMcBain

ASKER

Ok, I got it working, but it is rounding up. Instead of 10.50 it is giving me 11.

nico5038

Basically you need:
TotalDays - 2 - Weekends&Holidays) * 10.5 hours per day.
(When total days >=2)
and the parts of the startdate and the enddate.
Question is however or your period is consequetive...

Nic;o)

archery

Will check my example again later today (BUT I believe it is correct - my example FROM 16/8/02 8.45pm TO 20/8/02 7.25am, which became FROM 16/8/02 7.00pm TO 20/8/02 8.30am (based on your "replacement rules"), gave a result of 2250 (Business) minutes, which I believe is the result you want).

Also, you now say that you want to use a " * 10.5 hours per day ", but your original question only MADE it a 10.5 hour day if BOTH Start AND Finish hours were outside of your parameters. What did you actually want as a result if the Start Time was (say) 5.00 pm AND/OR the Finish Time was (say) 10.00am.

I am now getting confused as to what you want exatly.

To get your "calculated minutes" into Hours/Fractions use the following example :

Dim Ret_HoursMinutes as Variant

Ret_HoursMinutes = Round(Business_Minutes / 60, 2)

MsgBox Ret_HoursMinutes

archery

Apologies Valerie, the penny has just dropped. In my example I (wrongly) added 1440 minutes (a full 24 hour)day for Monday 19/8 instead of just a (maximum) 10.5 hours.
This does bring in a whole new complexity to it, if this situation can/could occur in your "real" world.
I will look at it again later (no time now), to see if I can get it working correctly, this certainly won't be wasted for me as I am sure that it (or something like it) will occur in the future, so it is a good exercise anyway.

VMcBain

ASKER

OK, I GOT IT!

HERE IS THE CODE I USED!

_________________________________________________________

Option Compare Database 'Use database order for string comparisons
Option Explicit ' Force explicit variable declaration.

Function test1()

Dim Start_Date As Date
Dim Start_Time As Date
Dim End_Date As Date
Dim End_Time As Date
Dim Start_DateTime As Date
Dim End_DateTime As Date
Dim RetVar As Variant

' --------------------------------------------------------------
' Alter these to reflect differing "test" results
Start_Date = #7/3/2002#
Start_Time = #4:30:00 PM#
End_Date = #8/15/2002#
End_Time = #4:30:00 PM#
' --------------------------------------------------------------

Start_DateTime = Start_Date & Space(1) & Start_Time
End_DateTime = End_Date & Space(1) & End_Time

RetVar = BusinessHours(Start_DateTime, End_DateTime)

MsgBox RetVar & " hours between dates"

End Function

Public Function BusinessHours(Input_Start As Date, _
Input_End As Date) As Double

Const Replacement_MorningTime As Date = #8:30:00 AM#
Const Replacement_EveningTime As Date = #7:00:00 PM#

Dim Start_Time As Date
Dim End_Time As Date

If Format(Input_Start, "Medium Time") < Replacement_MorningTime Then
Start_Time = Format(Input_Start, "Short Date") & Space(1) & Format(Replacement_MorningTime, "Medium Time")
Else
If Format(Input_Start, "Medium Time") > Replacement_EveningTime Then
Start_Time = Format(Input_Start, "Short Date") & Space(1) & Format(Replacement_EveningTime, "Medium Time")
Else
Start_Time = Input_Start
End If
End If

If Format(Input_End, "Medium Time") < Replacement_MorningTime Then
End_Time = Format(Input_End, "Short Date") & Space(1) & Format(Replacement_MorningTime, "Medium time")
Else
If Format(Input_End, "Medium Time") > Replacement_EveningTime Then
End_Time = Format(Input_End, "Short Date") & Space(1) & Format(Replacement_EveningTime, "Medium time")
Else
End_Time = Input_End
End If
End If

BusinessHours = glb_GetDiffInMinutes(Start_Time, End_Time)

End Function

Public Function glb_GetDiffInMinutes(dat_Start As Date, _
dat_End As Date) As Double

Dim WeekendsandHolidays As Double
Dim FullDayHours As Double
Dim FirstHours As Double
Dim LastHours As Double
Const Start_Time As Date = #8:30:00 AM#
Const End_Time As Date = #7:00:00 PM#
Dim StartStart_DateTime As Date
Dim EndEnd_DateTime As Date
Dim StartEnd_DateTime As Date
Dim EndStart_DateTime As Date

StartStart_DateTime = Format(dat_Start, "mm/dd/yyyy") & Space(1) & Format(Start_Time, "Medium Time")
EndEnd_DateTime = Format(dat_End, "mm/dd/yyyy") & Space(1) & Format(End_Time, "Medium Time")
StartEnd_DateTime = Format(dat_Start, "mm/dd/yyyy") & Space(1) & Format(End_Time, "Medium Time")
EndStart_DateTime = Format(dat_End, "mm/dd/yyyy") & Space(1) & Format(Start_Time, "Medium Time")

' Calculates the time (in minutes) between two dates.
' The parameters passed as "Date Type" can be - Dates ONLY
' - Dates and Times
'
' Makes calls to existing modules which can (optionally) exclude:
' defined days (normally Sat and Sun (weekends)
' holidays which may fall within the dates
'
' The default for the calls to these existing procedures is:
' Exclude Sat and Sun
' Exclude any dates which are holidays (TRUE)

If Format(dat_Start, "mm/dd/yyyy") = Format(dat_End, "mm/dd/yyyy") Then
If (Format(dat_Start, "Short Time") = #8:30:00 AM#) And (Format(dat_End, "Short Time") = #7:00:00 PM#) Then
glb_GetDiffInMinutes = 10.5
Else
glb_GetDiffInMinutes = DateDiff("n", dat_Start, dat_End) / 60
End If
Else
If Format(dat_End, "mm/dd/yyyy") = Format(DateAdd("d", 1, dat_Start), "mm/dd/yyyy") Then
FirstHours = DateDiff("n", dat_Start, StartEnd_DateTime) / 60
LastHours = DateDiff("n", EndStart_DateTime, dat_End) / 60
glb_GetDiffInMinutes = FirstHours + LastHours
Else
FirstHours = DateDiff("n", dat_Start, StartEnd_DateTime) / 60
LastHours = DateDiff("n", EndStart_DateTime, dat_End) / 60
WeekendsandHolidays = ((glb_GetDiffInDate("n", dat_Start, dat_End)) - (DiffBusinessDays_TSB(dat_Start, dat_End, "tHoliday", "HolidayDate") - 1) * (24 * 60)) / 60 / 24
FullDayHours = (((glb_GetDiffInDate("n", dat_Start, dat_End) / 24 / 60) - WeekendsandHolidays) - 1) * 10.5
glb_GetDiffInMinutes = FirstHours + FullDayHours + LastHours
End If
End If

End Function

Public Function glb_GetDiffInDate(ReqdInterval As String, _
Startdate As Date, _
EndDate As Date) As Double

'Intervals input can be : yyyy Year
' q Quarter
' M Month
' y Day of year
' d Day
' w WeekDay
' ww Week
' H Hour
' N Minute
' S Second

glb_GetDiffInDate = DateDiff(ReqdInterval, Startdate, EndDate)

End Function

Function DiffBusinessDays_TSB(datDay1 As Date, datDay2 As Date, _
strHolidayTbl As String, strHolidayDate As String) As Double

' Comments : Returns the number of business days between two dates
' The days are rounded down -- it takes 24 hours to make a day.
' Weekend dates (Saturday and Sunday) and holidays are not counted.
' Parameters: datDay1 - first (earlier) date/time (subtracted from datDay2)
' datDay2 - second (later) date/time
' strHolidayTbl - name of holiday table
' strHolidayDate - field name of holiday dates in the holiday table
' Returns : Number of whole business days between two dates
' (Returns negative days if datDay1 is after datDay2)

Dim db As Database
Dim rst As Recordset

Dim strSQL As String, strField As String
Dim lngBusinessDays As Double, lngWeekdays As Double

Dim Startdate As Date, EndDate As Date

lngWeekdays = DiffWeekDays_TSB(datDay1, datDay2)

Startdate = Format(datDay1, "mm/dd/yyyy")
EndDate = Format(datDay2, "mm/dd/yyyy")

Set db = DBEngine(0)(0)

strField = "[" & strHolidayTbl & "].[" & strHolidayDate & "]"

strSQL = "SELECT DISTINCTROW Count(" & strField & ") AS Count" & _
" FROM [" & strHolidayTbl & "]" & _
" WHERE ((" & strField

If datDay1 <= datDay2 Then
strSQL = strSQL & ">=#" & datDay1 & "# And " & _
strField & "<#" & datDay2 & "#));"
Else
strSQL = strSQL & ">=#" & datDay2 & "# And " & _
strField & "<=#" & datDay1 & "#));"
End If

Set rst = db.OpenRecordset(strSQL)
lngBusinessDays = rst![Count]
rst.Close
db.Close

' MsgBox "Number of weekdays = " & lngWeekdays
' MsgBox "Number of holidays = " & lngBusinessDays
' MsgBox "Number of business days = " & (lngWeekdays - lngBusinessDays)

DiffBusinessDays_TSB = lngWeekdays - lngBusinessDays

End Function
Public Function DiffWeekDays_TSB(datDay1 As Date, datDay2 As Date) As Double

' Comments : Returns the number of holidays days between two dates
' Weekend dates (Saturday and Sunday) are not counted.
' Parameters: datDay1 - first (earlier) date/time (subtracted from datDay2)
' datDay2 - second (later) date/time
' Returns : Number of Holidays between two dates
' (Returns negative days if datDay1 is after datDay2)

Dim lngWeekdays As Double

Dim Startdate As Date, EndDate As Date

lngWeekdays = 0
Startdate = Format(datDay1, "Short Date")
EndDate = Format(datDay2, "Short Date")

Do Until Startdate > EndDate
If Weekday(Startdate) <> 1 And Weekday(Startdate) <> 7 Then
lngWeekdays = lngWeekdays + 1
End If
Startdate = Format(DateAdd("d", 1, Startdate), "Short Date")
Loop

DiffWeekDays_TSB = lngWeekdays

End Function

Function HolidayTableFill_TSB(strHolidayTbl As String, strHolidayDate As String, _
strHolidayDay As String, strHolidayName As String, intFirstYear As Integer, intLastYear As Integer)

' Comments : Add holiday dates to a holiday table
' Assumes table already exists and does not include the dates being added.
' Parameters: strHolidayTbl - name of holiday table
' strHolidayDate - field name of holiday dates in the holiday table
' strHolidayDay - field name of holiday day name in the holiday table
' strHolidayName - field name of description field (optional)
' intFirstYear - first year
' intLastYear - last year
'
Dim db As Database
Dim rstHoliday As Recordset
Dim intYear As Integer
Dim datHoliday As Date

Set db = DBEngine(0)(0)
Set rstHoliday = db.OpenRecordset(strHolidayTbl)

For intYear = intFirstYear To intLastYear

' New Year's Day (January 1)
datHoliday = HolidayDate_TSB(CDate("1/1/" & intYear))
Call HolidayTblWrite_TSB(datHoliday, rstHoliday, strHolidayDate, strHolidayDay, strHolidayName, "New Year's Day")

' Memorial Day (Last Monday in May)
datHoliday = (NthDayOfMonth_TSB(6, intYear, 1, 2)) - 7
Call HolidayTblWrite_TSB(datHoliday, rstHoliday, strHolidayDate, strHolidayDay, strHolidayName, "Memorial Day")

' Independence Day (July 4)
datHoliday = HolidayDate_TSB(CDate("7/4/" & intYear))
Call HolidayTblWrite_TSB(datHoliday, rstHoliday, strHolidayDate, strHolidayDay, strHolidayName, "Independence Day")

' Labor Day (1st Monday in September)
datHoliday = NthDayOfMonth_TSB(9, intYear, 1, 2)
Call HolidayTblWrite_TSB(datHoliday, rstHoliday, strHolidayDate, strHolidayDay, strHolidayName, "Labor Day")

' Thanksgiving Day (4th Thursday in November)
datHoliday = NthDayOfMonth_TSB(11, intYear, 4, 5)
Call HolidayTblWrite_TSB(datHoliday, rstHoliday, strHolidayDate, strHolidayDay, strHolidayName, "Thanksgiving")

' Christmas (December 25)
datHoliday = HolidayDate_TSB(CDate("12/25/" & intYear))
Call HolidayTblWrite_TSB(datHoliday, rstHoliday, strHolidayDate, strHolidayDay, strHolidayName, "Christmas")

Next intYear

rstHoliday.Close
db.Close

End Function

Function HolidayDate_TSB(datDay As Date) As Date
' Comments : For fixed date holidays (New Year's, 4th of July, Christmas),
' returns the celebrated date based on Federal guidelines
' Saturday & Sunday dates are shifted to Monday.
' Parameters: datDay - date to calculate
' Returns : Adjusted holiday date
'
Dim datHoliday As Date

datHoliday = CDate(datDay)
Select Case Weekday(datDay)
Case 1: datHoliday = datHoliday + 1 ' Shift Sunday to Monday
Case 7: datHoliday = datHoliday + 2 ' Shift Saturday to Monday
End Select

HolidayDate_TSB = datHoliday

End Function

Function NthDayOfMonth_TSB(intMonth As Integer, intYear As Integer, _
intOccurrence As Integer, intDay As Integer) As Variant

' Comments : Returns the date of the Nth day (Monday, Tuesday, etc.) of the month
' Parameters: intMonth - month to check
' intYear - year to check
' intOccurrence - the occurrence number of the day to calculate
' (1 for first, 2 for second, etc.)
' intDay - the day of the week to calculate (1 for Sunday, 2 for Monday, etc.)
' Returns : Nth day of month (null if date does not exist)
'
Dim varTempDate As Variant
Dim intCurrDay As Integer

varTempDate = DateSerial(intYear, intMonth, 1)

If (intDay > 0) And (intDay < 8) And (intOccurrence > 0) Then
' Calculate first intDay of the month.
intCurrDay = Weekday(varTempDate)
If intCurrDay <> intDay Then
If intCurrDay < intDay Then
varTempDate = varTempDate + (intDay - intCurrDay)
Else
varTempDate = varTempDate + (7 + intDay - intCurrDay)
End If
End If
If intOccurrence > 1 Then
varTempDate = varTempDate + 7 * (intOccurrence - 1)
If Month(varTempDate) <> intMonth Then ' Date goes past month
varTempDate = Null
End If
End If
Else
varTempDate = Null
End If

NthDayOfMonth_TSB = varTempDate

End Function

Function HolidayTblWrite_TSB(datHoliday As Date, rsHoliday As Recordset, _
strHolidayDate As String, strHolidayDay As String, strHolidayName As String, strDescription As String)

' Comments : Add a record to the holiday table
' Used in an example of filling the holiday table
' Parameters: datHoliday - holiday date to add
' rsHoliday - recordset pointing to the holiday table
' strHolidayDate - field name to put the holiday date
' strHolidayDay - field name to put the (abbreviated) day name for the holiday
' strHolidayName - field name to enter description (optional)
' NOTE: Does not check to see if the date is already in the table.
'
Dim DayOfWeek As String

rsHoliday.AddNew
rsHoliday(strHolidayDate) = datHoliday
If strHolidayDay <> "" Then
Select Case Weekday(datHoliday)
Case 1
DayOfWeek = "Sun"
Case 2
DayOfWeek = "Mon"
Case 3
DayOfWeek = "Tue"
Case 4
DayOfWeek = "Wed"
Case 5
DayOfWeek = "Thu"
Case 6
DayOfWeek = "Fri"
Case 7
DayOfWeek = "Sat"
End Select
rsHoliday(strHolidayDay) = DayOfWeek
End If
If strHolidayName <> "" Then
rsHoliday(strHolidayName) = strDescription
End If
rsHoliday.Update

End Function
_________________________________________________________

Thank you for your Help!

Valerie

P.S.
Archery, I will give you the points for helping me get this worked out!

archery

Valerie, Glad to have helped. Will compare yours to mine to see what improvements you have made.

One last thing that I had thought about but didn't test is :

What would the effect be if either/both of your start/end dates was for a date which coincided with either a weekend or a holiday date, and you had "requested" that such dates be ignored ?

This might be a scenario that you should look at, before the "real world" comes back and bites you/me.

VMcBain

ASKER

Archery,

Right now it is not calculating correctly if the start and stop are on a weekend. I will have to add a check to see if it is a saturday or sunday and "move" the start date to the next weekday at 8:30 am and/or the end date to the prior weekday at 7:00 pm respectively. Same if it is a holiday.

Thanks!

Valerie

VMcBain

ASKER

Ok I fixed it. I Modified one function and created a new one. Here is the code:

Public Function BusinessHours(Input_Start As Date, _
Input_End As Date) As Double

Const Replacement_MorningTime As Date = #8:30:00 AM#
Const Replacement_EveningTime As Date = #7:00:00 PM#

Dim Start_Time As Date
Dim End_Time As Date

If CountHolidays(Input_Start, "tHoliday", "HolidayDate") = 1 Then
Start_Time = Format(DateAdd("d", 1, Input_Start), "Short Date") & Space(1) & Format(Replacement_MorningTime, "Medium Time")
Else
If Format(Input_Start, "w") = 7 Then
Start_Time = Format(DateAdd("d", 2, Input_Start), "Short Date") & Space(1) & Format(Replacement_MorningTime, "Medium Time")
Else
If Format(Input_Start, "w") = 1 Then
Start_Time = Format(DateAdd("d", 1, Input_Start), "Short Date") & Space(1) & Format(Replacement_MorningTime, "Medium Time")
Else
If Format(Input_Start, "Medium Time") < Replacement_MorningTime Then
Start_Time = Format(Input_Start, "Short Date") & Space(1) & Format(Replacement_MorningTime, "Medium Time")
Else
If Format(Input_Start, "Medium Time") > Replacement_EveningTime Then
Start_Time = Format(Input_Start, "Short Date") & Space(1) & Format(Replacement_EveningTime, "Medium Time")
Else
Start_Time = Input_Start
End If
End If
End If
End If
End If

If CountHolidays(Input_End, "tHoliday", "HolidayDate") = 1 Then
End_Time = Format(DateAdd("d", 1, Input_End), "Short Date") & Space(1) & Format(Replacement_MorningTime, "Medium Time")
Else
If Format(Input_End, "w") = 7 Then
End_Time = Format(DateAdd("d", 2, Input_End), "Short Date") & Space(1) & Format(Replacement_MorningTime, "Medium Time")
Else
If Format(Input_End, "w") = 1 Then
End_Time = Format(DateAdd("d", 1, Input_End), "Short Date") & Space(1) & Format(Replacement_MorningTime, "Medium Time")
Else
If Format(Input_End, "Medium Time") < Replacement_MorningTime Then
End_Time = Format(Input_End, "Short Date") & Space(1) & Format(Replacement_MorningTime, "Medium time")
Else
If Format(Input_End, "Medium Time") > Replacement_EveningTime Then
End_Time = Format(Input_End, "Short Date") & Space(1) & Format(Replacement_EveningTime, "Medium time")
Else
End_Time = Input_End
End If
End If
End If
End If
End If

BusinessHours = glb_GetDiffInMinutes(Start_Time, End_Time)

End Function

'------------------------
'New Function
'------------------------

Function CountHolidays(Day1 As Date, _
strHolidayTbl As String, strHolidayDate As String) As Double

' Comments : Checks to see if the date given is a Holiday
'
' Parameters: Day1 - Date to compare date/time
' strHolidayTbl - name of holiday table
' strHolidayDate - field name of holiday dates in the holiday table
' Returns : Number of holidays for the date 1 or 0

Dim db As Database
Dim rst As Recordset

Dim strSQL As String, strField As String
Dim lngHolidays As Double

Dim Startdate As Date

Startdate = Format(Day1, "mm/dd/yyyy")

Set db = DBEngine(0)(0)

'SELECT Count(tHoliday.HolidayDate) AS CountOfHolidayDate
'From tHoliday
'WHERE (((tHoliday.HolidayDate)=[Startdate]));

strField = "[" & strHolidayTbl & "].[" & strHolidayDate & "]"

strSQL = "SELECT DISTINCTROW Count(" & strField & ") AS Count" & _
" FROM [" & strHolidayTbl & "]" & _
" WHERE ((" & strField

strSQL = strSQL & "=#" & Startdate & "#));"

Set rst = db.OpenRecordset(strSQL)
lngHolidays = rst![Count]
rst.Close
db.Close

' MsgBox "Number of holidays = " & lngHolidays

CountHolidays = lngHolidays

End Function

______________________________________

Now it works no matter what!

Thanks!

Valerie

archery

Valerie, glad you can say that you have it working, BUT .... I think I see a little problem with your code in "Function BusinessHours" (snipped below)

' --------- < snip > ------------

If CountHolidays(Input_Start, "tHoliday", "HolidayDate") = 1 Then
Start_Time = Format(DateAdd("d", 1, Input_Start), "Short Date") & Space(1) & Format(Replacement_MorningTime, "Medium Time")
Else
If Format(Input_Start, "w") = 7 Then
Start_Time = Format(DateAdd("d", 2, Input_Start), "Short Date") & Space(1) & Format(Replacement_MorningTime, "Medium Time")
Else
If Format(Input_Start, "w") = 1 Then
Start_Time = Format(DateAdd("d", 1, Input_Start), "Short Date") & Space(1) & Format(Replacement_MorningTime, "Medium Time")

' ---------- < end snip > ---------------

In ALL of the above "If's" where you determine that it is a holiday/Saturday/Sunday, you simply add the appropriate number of "days" to your original input date. BUT, you THEN don't check that this (adjusted date) is ALSO not a holiday/Saturday/Sunday (here in the land of OZ, Xmas day is followed by Boxing Day, so we can have consecutive holidays, and even in your holiday table, any holiday that falls on a Friday you would adjust by 1 day making it a Saturday, but your code doesn't follow-up with this).

I believe you need to do a (code) LOOP adjusting the date appropriately until it doesn't coincide with a holiday/Saturday/Sunday.

You also have the same problem with the next set of (major) "If's" relating to the 'End Date' which should be adjusted via another (code) LOOP.

You (new but problem(?) code) line :
If CountHolidays(Input_Start, "tHoliday", "HolidayDate") = 1 Then ......

I would have simply done as :

IF NZ(DCount("*", "tHoliday", "HolidayDate = " & Input_Start)) <> 0 THEN .....

rather than a (new) module call, but the new module is certainly not wrong. Maybe I'm just lazy.

Now, if I can make another suggestion (and I had thought of this some days ago) ..... instead of having your default 'Morning and Evening' times "hard-coded" as :

Const Replacement_MorningTime As Date = #8:30:00 AM#
Const Replacement_EveningTime As Date = #7:00:00 PM#

I might suggest you actually place these times into a table which is accessed at the start of the "Function BusinessHours", which allows you to easily adjust them if/when it may become appropriate, and does NOT require you to go back to your code and make a change. This gives you the flexibility of 'business change' without 'coding change'.
If you went with this suggestion, you would have to look back to your existing code and replace where you have (also) hard-coded 7.00pm and 8.30am, and your (single) entry of 10.5 in "Function glb_GetDiffInMinutes". You altered this dramatically from what I originally posted, and which I (subsequently) didn't even end up calling (because of my '24*60' problem which you found).

Lots of (final) luck with this. It has given me some answers to processes which I probably needed at some time as well. As I said earlier, that's the beauty of forums like this.

VMcBain

ASKER

Here at my company we only have six days that we consider a "holiday", and they all fall on a week day. Hence the reason that I check for it to be a holiday first, then if it is a weekend day, then I move it to the next monday. We don't have any holidays that are next to each other, so we don't need the loop. However, if this were to be used in another person's code that needed it to check that, they could certainly add the LOOP.

Thanks for all of your suggestions! I may use the "Replacement hours" table idea.

Valerie

VMcBain

ASKER

For those of you "borrowing" the code, read the entire converstation between Valerie and Archery. We made quite a few changes along the way to the final code.

Thanks!

Valerie

archery

Valerie, thanks for the points, and glad that it has worked for you,, BUT (again)... I think you have to be careful with your (current) code if you didn't do (either a loop, or at least a second check AFTER you find that your original date (start &/or end) are a holiday.

You say ..."we only have six days that we consider a "holiday", and they all fall on a week day", but looking back thru your USA "holiday creation routine", of the 6 days that are there, 3 CANNOT be assured of "fall(ing) on a week day".

They are: New Year's Day (January 1)
Independence Day (July 4)
Christmas (December 25)

Actually, looking back at your (current) code (posted into EE 08/20/2002 10:21am PST), with ALL the "nested Iif's" you have there, not ONLY do you NOT check if the "holiday-adjusted-date" doesn't then become (at least) a Saturday, BUT you ONLY check if the "Start" AND "End" times (portion) of your input parameter is outside your "pre-defined" times IF NO adjustment has been done to a "date portion" for ANY reason.

I believe it should look like this (you adjust the "input start parameter" for the "date portion" ONLY first, then check for the "time portion") :

' ------ < suggested code change >-----------------

If CountHolidays(Input_Start, "tHoliday", "HolidayDate") = 1 Then
' It is a holiday date, so add 1 to the original Input_Date parameter
Input_Start = DateAdd("d", 1, Input_Start)
End If

' NOW, check that that the Input_date is NOT a Saturday or Sunday

If Format(Input_Start, "w") = 7 Then
' It is a Saturday, so add 2 to the original Input_Date parameter
Input_Start = DateAdd("d", 2, Input_Start)
Else
If Format(Input_Start, "w") = 1 Then
' It is a holiday date, so add 1 to the original Input_Date parameter
Input_Start = DateAdd("d", 1, Input_Start)
End If
End If

' NOW, check that the Input_Time is within your pre-defined times.
' If NOT, replace that portion ONLY

If Format(Input_Start, "Medium Time") < Replacement_MorningTime Then
Start_Time = Format(Input_Start, "Short Date") & Space(1) & Format(Replacement_MorningTime, "Medium Time")
Else
If Format(Input_Start, "Medium Time") > Replacement_EveningTime Then
Start_Time = Format(Input_Start, "Short Date") & Space(1) & Format(Replacement_EveningTime, "Medium Time")
Else
Start_Time = Input_Start
End If

' -----------------------------------------------

You would have to do the same as the above for the "End" parameter input, making the appropriate variable-name changes.

Sorry if I seem a bit "gun-ho" about this, but I am also getting this right for my own purposes (I would have to be doing a loop within the "holiday check" code above because of our "consecutive days" possibility).

Whoops !!! - just though about yours again (and my previously mentioned comment about having to "manually" load Easter holidays into the "holiday table"), wouldn't this also be applicable to the USA where the Sat/Sun became Easter Monday.

Damn it !!! - this is how I would do it .. (you can choose)

' ---------< Handles ALL situations > --------------

Dim AdjustDate As String * 1

' Firstly, check the "Start" parameter input

AdjustDate = "Y"

Do Until Adjust_Date = "N"
If CountHolidays(Input_Start, "tHoliday", "HolidayDate") = 1 _
Or Format(Input_Start, "w") = 7 _
Or Format(Input_Start, "w") = 1 Then
' It is a holiday date/Saturday/Sunday, add 1 to the original Input_Date parameter
' and loop again
Input_Start = DateAdd("d", 1, Input_Start)
Adjust_Date = "Y"
Else
Adjust_Date = "N"
End If
Loop

' NOW, check that the "Start" Input_Time is within your pre-defined times.
' If NOT, replace that portion ONLY

If Format(Input_Start, "Medium Time") < Replacement_MorningTime Then
Start_Time = Format(Input_Start, "Short Date") & Space(1) & Format(Replacement_MorningTime, "Medium Time")
Else
If Format(Input_Start, "Medium Time") > Replacement_EveningTime Then
Start_Time = Format(Input_Start, "Short Date") & Space(1) & Format(Replacement_EveningTime, "Medium Time")
Else
Start_Time = Input_Start
End If

' Secondly, check the "End" parameter input

AdjustDate = "Y"

Do Until Adjust_Date = "N"
If CountHolidays(Input_End, "tHoliday", "HolidayDate") = 1 _
Or Format(Input_End, "w") = 7 _
Or Format(Input_End, "w") = 1 Then
' It is a holiday date/Saturday/Sunday, add 1 to the original Input_Date parameter
' and loop again
Input_End = DateAdd("d", 1, Input_End)
Adjust_Date = "Y"
Else
Adjust_Date = "N"
End If
Loop

' NOW, check that the "End" Input_Time is within your pre-defined times.
' If NOT, replace that portion ONLY

If Format(Input_End, "Medium Time") < Replacement_MorningTime Then
Start_Time = Format(Input_End, "Short Date") & Space(1) & Format(Replacement_MorningTime, "Medium Time")
Else
If Format(Input_End, "Medium Time") > Replacement_EveningTime Then
Start_Time = Format(Input_End, "Short Date") & Space(1) & Format(Replacement_EveningTime, "Medium Time")
Else
End_Time = Input_End
End If

' ---------< End Code change > ------------------------

VMcBain

ASKER

Archery,

You are correct when you said "...with ALL the "nested if's" you have there, not ONLY do you NOT check if the "holiday-adjusted-date" doesn't then become (at least) a Saturday, BUT you ONLY check if the "Start" AND "End" times (portion) of your input parameter is outside your "pre-defined" times IF NO adjustment has been done to a "date portion" for ANY reason."

So, I un-nested all the If statements.

Thanks,

Valerie

VMcBain

ASKER

Also, per your holiday code below the fixed holidays such as July 4 as shifted to Monday.

Function HolidayDate_TSB(datDay As Date) As Date
' Comments : For fixed date holidays (New Year's, 4th of July, Christmas),
' returns the celebrated date based on Federal guidelines
' Saturday & Sunday dates are shifted to Monday.
' Parameters: datDay - date to calculate
' Returns : Adjusted holiday date
'
Dim datHoliday As Date

datHoliday = CDate(datDay)
Select Case Weekday(datDay)
Case 1: datHoliday = datHoliday + 1 ' Shift Sunday to Monday
Case 7: datHoliday = datHoliday + 2 ' Shift Saturday to Monday
End Select

HolidayDate_TSB = datHoliday

End Function

Thanks,

Valerie

archery

Valerie, the function "HolidayDate_TSB" is ONLY called when building the (original) Holiday table data. This means that if (say) 4th July (actually) fell on a Saturday, during the holiday table build, 2 days would be added to the input date, thus being stored as 6/7 (Monday).

Now,.... during the process for "calculating business hours between dates, including holidays (etc)", where (either) your start/end date was 4/7/nn (i.e. Saturday), IF you DON'T use the (suggested) loop, your code would do the following:

(i) would NOT find it in the "holiday table" - (4/7/ became 6/7 when originally stored)

(ii) would then determine that (the unchanged date) was a Saturday, and simply add 2 days to it making it 6/7

(iii) simply carry on merrily without (actually) finding that in reality the 6/7 was a holiday.

All this, of course, depends on your actual business rules, so I can only suggest what you could/should do.

As an (ex) Prime Minister (read "President", but without a big red-button to push) here in OZ once said .... "Life wasn't meant to be easy"

VMcBain

ASKER

Ok, I changed it again. Your code was almost correct, but it didn't move the date and time. If the date was a holiday/Saturday/Sunday move the date to the next available business day and the start time to the Replacement time, so here is what I did:

---------------------------------------------------------
Public Function BusinessHours(Input_Start As Date, _
Input_End As Date) As Double

Const Replacement_MorningTime As Date = #8:30:00 AM#
Const Replacement_EveningTime As Date = #7:00:00 PM#

Dim Start_Time As Date
Dim End_Time As Date
Dim AdjustDate As String

AdjustDate = "Y"

Do Until Adjust_Date = "N"
If CountHolidays(Input_Start, "tHoliday", "HolidayDate") = 1 Or Format(Input_Start, "w") = 7 Or Format(Input_Start, "w") = 1 Then
Input_Start = Format(DateAdd("d", 1, Input_Start), "Short Date") & Space(1) & Format(Replacement_MorningTime, "Medium Time")
Adjust_Date = "Y"
Else
Adjust_Date = "N"
End If
Loop

If Format(Input_Start, "Medium Time") < Replacement_MorningTime Then
Start_Time = Format(Input_Start, "Short Date") & Space(1) & Format(Replacement_MorningTime, "Medium Time")
Adjust_Date = "Y"
Else
End If
If Format(Input_Start, "Medium Time") > Replacement_EveningTime Then
Start_Time = Format(Input_Start, "Short Date") & Space(1) & Format(Replacement_EveningTime, "Medium Time")
Adjust_Date = "Y"
Else
Start_Time = Input_Start
End If

AdjustDate = "Y"

Do Until Adjust_Date = "N"
If CountHolidays(Input_End, "tHoliday", "HolidayDate") = 1 Or Format(Input_End, "w") = 7 Or Format(Input_End, "w") = 1 Then
Input_End = Format(DateAdd("d", 1, Input_End), "Short Date") & Space(1) & Format(Replacement_MorningTime, "Medium Time")
Else
AdjustDate = "N"
End If
Loop

If Format(Input_End, "Medium Time") < Replacement_MorningTime Then
End_Time = Format(Input_End, "Short Date") & Space(1) & Format(Replacement_MorningTime, "Medium time")
Else
End If
If Format(Input_End, "Medium Time") > Replacement_EveningTime Then
End_Time = Format(Input_End, "Short Date") & Space(1) & Format(Replacement_EveningTime, "Medium time")
Else
End_Time = Input_End
End If

BusinessHours = glb_GetDiffInMinutes(Start_Time, End_Time)

End Function
----------------------------

Hope this is it!

Thanks,

Valerie