Hello SusanSSS,
You can use these UDFs to caluclate the "working time":
Function WorkingHrs(StartAt As Date, EndAt As Date, WorkStart As Date, WorkEnd As Date, Workdays As String, _
ParamArray Holidays())
' Function calculates working hours available within a specified datetime range, allowing for
' scheduled working hours, non-working days, and holidays (if desired)
' Workdays specifies days employees normally work. For example, to use Mon - Fri, use 23456.
' To do just Tue & Thu, use 35; etc.
' Assumes scheduled working hrs are the same on each working day!
' To use this function to calculate "working days", then simply divide the result from the function by
' the length of a standard workday in hours.
Dim Counter As Long
Dim Dict As Object
Dim x As Variant
Dim y As Variant
Dim Days(1 To 7) As Boolean
Dim WorkThisDay As Boolean
Dim HolThisDay As Boolean
Dim DateToday As Date
Dim DayStart As Date
Dim DayEnd As Date
' array indicates whether that weekday is a regular workday. Initialize to False
Days(1) = False
Days(2) = False
Days(3) = False
Days(4) = False
Days(5) = False
Days(6) = False
Days(7) = False
' populate array with results from Workdays argument
For Counter = 1 To Len(Workdays)
Days(Val(Mid(Workdays, Counter, 1))) = True
Next
On Error GoTo Cleanup
' populate holiday array
If Not IsMissing(Holidays) Then
Set Dict = CreateObject("Scripting.Dictionary")
For Each x In Holidays
' Each element of Holidays may itself be an array (or an Excel range with >1 cell). Test for that,
' and iterate through the elements of *that* array if needed. If not, then simply process the
' current element
If IsArray(x) Then
For Each y In x
If Not Dict.Exists(Format(y, "m/d/yyyy")) Then Dict.Add Format(y, "m/d/yyyy"), Format(y, "m/d/yyyy")
Next
Else
If Not Dict.Exists(Format(x, "m/d/yyyy")) Then Dict.Add Format(x, "m/d/yyyy"), Format(x, "m/d/yyyy")
End If
Next
End If
'loop through days in datetime range
For Counter = Int(StartAt) To Int(EndAt)
DateToday = CDate(Counter)
' determine if regular workday
WorkThisDay = Days(Weekday(DateToday, vbSunday))
' determine if holiday
If IsMissing(Holidays) Then
HolThisDay = False
Else
If Dict.Exists(Format(DateToday, "m/d/yyyy")) Then HolThisDay = True Else HolThisDay = False
End If
' if regular workday and not a holiday, figure out hrs from that day
If WorkThisDay And Not HolThisDay Then
' starts and ends on same day
If Int(StartAt) = Int(EndAt) Then
DayStart = IIf(CDate(StartAt - Int(StartAt)) > WorkStart, CDate(StartAt - Int(StartAt)), WorkStart)
DayEnd = IIf(CDate(EndAt - Int(EndAt)) < WorkEnd, CDate(EndAt - Int(EndAt)), WorkEnd)
WorkingHrs = IIf(CDbl(DayEnd - DayStart) < 0, 0, CDbl(DayEnd - DayStart))
' first day, if first day <> last day
ElseIf Counter = Int(StartAt) Then
DayStart = IIf(CDate(StartAt - Int(StartAt)) > WorkStart, CDate(StartAt - Int(StartAt)), WorkStart)
DayEnd = WorkEnd
WorkingHrs = IIf(CDbl(DayEnd - DayStart) < 0, 0, CDbl(DayEnd - DayStart))
' days in between start and end, if any
ElseIf Counter > Int(StartAt) And Counter < Int(EndAt) Then
WorkingHrs = WorkingHrs + CDbl(WorkEnd - WorkStart)
' last day, if first day <> last day
ElseIf Counter = Int(EndAt) Then
DayStart = IIf(CDate(EndAt - Int(EndAt)) > WorkStart, WorkStart, CDate(EndAt - Int(EndAt)))
DayEnd = IIf(CDate(EndAt - Int(EndAt)) < WorkEnd, CDate(EndAt - Int(EndAt)), WorkEnd)
WorkingHrs = WorkingHrs + IIf(CDbl(DayEnd - DayStart) < 0, 0, CDbl(DayEnd - DayStart))
End If
End If
Next
' convert days to hours
WorkingHrs = WorkingHrs * 24
Cleanup:
On Error GoTo 0
Set Dict = Nothing
End Function
Function WorkingHrsHolTbl(StartAt As Date, EndAt As Date, WorkStart As Date, WorkEnd As Date, Workdays As String, _
Optional HolidayTblName As String = "", Optional HolidayDateColName As String = "")
' This function is intended for use in Access, in which you may have a table that defines
' holidays. Holidays are always considered non-working days, and override the normal business
' days provided in the Workdays argument
' Requires reference to DAO library!
' Function calculates working hours available within a specified datetime range, allowing for
' scheduled working hours, non-working days, and holidays (if desired)
' Workdays specifies days employees normally work. For example, to use Mon - Fri, use 23456.
' To do just Tue & Thu, use 35; etc.
' assumes scheduled working hrs are the same on each working day!
Dim Counter As Long
Dim Dict As Object
Dim x As Variant
Dim y As Variant
Dim Days(1 To 7) As Boolean
Dim WorkThisDay As Boolean
Dim HolThisDay As Boolean
Dim DateToday As Date
Dim DayStart As Date
Dim DayEnd As Date
Dim rs As DAO.Recordset
' array indicates whether that weekday is a regular workday. Initialize to False
Days(1) = False
Days(2) = False
Days(3) = False
Days(4) = False
Days(5) = False
Days(6) = False
Days(7) = False
' populate array with results from Workdays argument
For Counter = 1 To Len(Workdays)
Days(Val(Mid(Workdays, Counter, 1))) = True
Next
On Error GoTo Cleanup
' populate holiday array
If HolidayTblName <> "" And HolidayDateColName <> "" Then
' test for brackets around table/column names, just in case they are needed and user omitted them
If Left(HolidayTblName, 1) <> "[" Then HolidayTblName = "[" & HolidayTblName
If Right(HolidayTblName, 1) <> "]" Then HolidayTblName = HolidayTblName & "]"
If Left(HolidayDateColName, 1) <> "[" Then HolidayDateColName = "[" & HolidayDateColName
If Right(HolidayDateColName, 1) <> "]" Then HolidayDateColName = HolidayDateColName & "]"
Set rs = CurrentDb.OpenRecordset("SELECT " & HolidayDateColName & " FROM " & HolidayTblName)
Set Dict = CreateObject("Scripting.Dictionary")
Do Until rs.EOF
If Not Dict.Exists(Format(rs.Fields(0), "m/d/yyyy")) Then
Dict.Add Format(rs.Fields(0), "m/d/yyyy"), Format(rs.Fields(0), "m/d/yyyy")
End If
rs.MoveNext
Loop
rs.Close
Set rs = Nothing
End If
'loop through days in datetime range
For Counter = Int(StartAt) To Int(EndAt)
DateToday = CDate(Counter)
' determine if regular workday
WorkThisDay = Days(Weekday(DateToday, vbSunday))
' determine if holiday
If HolidayTblName = "" Or HolidayDateColName = "" Then
HolThisDay = False
Else
If Dict.Exists(Format(DateToday, "m/d/yyyy")) Then HolThisDay = True Else HolThisDay = False
End If
' if regular workday and not a holiday, figure out hrs from that day
If WorkThisDay And Not HolThisDay Then
' starts and ends on same day
If Int(StartAt) = Int(EndAt) Then
DayStart = IIf(CDate(StartAt - Int(StartAt)) > WorkStart, CDate(StartAt - Int(StartAt)), WorkStart)
DayEnd = IIf(CDate(EndAt - Int(EndAt)) < WorkEnd, CDate(EndAt - Int(EndAt)), WorkEnd)
WorkingHrsHolTbl = IIf(CDbl(DayEnd - DayStart) < 0, 0, CDbl(DayEnd - DayStart))
' first day, if first day <> last day
ElseIf Counter = Int(StartAt) Then
DayStart = IIf(CDate(StartAt - Int(StartAt)) > WorkStart, CDate(StartAt - Int(StartAt)), WorkStart)
DayEnd = WorkEnd
WorkingHrsHolTbl = IIf(CDbl(DayEnd - DayStart) < 0, 0, CDbl(DayEnd - DayStart))
' days in between start and end, if any
ElseIf Counter > Int(StartAt) And Counter < Int(EndAt) Then
WorkingHrsHolTbl = WorkingHrsHolTbl + CDbl(WorkEnd - WorkStart)
' last day, if first day <> last day
ElseIf Counter = Int(EndAt) Then
DayStart = IIf(CDate(EndAt - Int(EndAt)) > WorkStart, WorkStart, CDate(EndAt - Int(EndAt)))
DayEnd = IIf(CDate(EndAt - Int(EndAt)) < WorkEnd, CDate(EndAt - Int(EndAt)), WorkEnd)
WorkingHrsHolTbl = WorkingHrsHolTbl + IIf(CDbl(DayEnd - DayStart) < 0, 0, CDbl(DayEnd - DayStart))
End If
End If
Next
' convert days to hours
WorkingHrsHolTbl = WorkingHrsHolTbl * 24
Cleanup:
On Error GoTo 0
Set Dict = Nothing
End Function
To use WorkingHrs, use an expression such as:
SELECT Start, Finish, WorkingHrs(Start, Finish, #9:00 AM#, #8:50 PM#, "23456") + WorkingHrs(Start, Finish, #8:00 AM#, #11:50 AM#, "7") AS WorkTime
FROM SomeTable
Because you indicated you have different "open hours" for Mon-Fri and for Sat, I needed two different expressions.
If you have a table for holidays that you would want to exclude, you can use:
SELECT Start, Finish, WorkingHrsHolTbl(Start, Finish, #9:00 AM#, #8:50 PM#, "23456", "tblHolidays", "HolidayDate") +
WorkingHrsHolTbl(Start, Finish, #8:00 AM#, #11:50 AM#, "7", "tblHolidays", "HolidayDate") AS WorkTime
FROM SomeTable
Regards,
Patrick
