Public Function Workdays(ByRef StartDate As Date, ByRef EndDate As Date, Optional ByRef strHolidays As String = "Holidays") As Integer
' Returns the number of workdays between startDate
' and endDate inclusive. Workdays excludes weekends and
' holidays. Optionally, pass this function the name of a table
' or query as the third argument. If you don't the default
' is "Holidays".
On Error GoTo Workdays_Error
Dim nWeekdays As Integer
Dim nHolidays As Integer
Dim strWhere As String
' DateValue returns the date part only.
StartDate = DateValue(StartDate)
EndDate = DateValue(EndDate)
nWeekdays = Weekdays(StartDate, EndDate)
If nWeekdays = -1 Then
Workdays = -1
GoTo Workdays_Exit
End If
strWhere = "[Holiday] >= #" & StartDate _
& "# AND [Holiday] <= #" & EndDate & "#"
' Count the number of holidays.
nHolidays = DCount(Expr:="[Holiday]", _
Domain:=strHolidays, _
Criteria:=strWhere)
Workdays = nWeekdays - nHolidays
Workdays_Exit:
Exit Function
Workdays_Error:
Workdays = -1
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Workdays"
Resume Workdays_Exit
End Function
Public Function Workhours(ByRef StartDate As Date, ByRef EndDate As Date, Optional ByRef strHolidays As String = "Holidays") As Double
On Error GoTo Workhours_Error
Dim WorkDaysInt As Integer
Dim FirstDayTime As Double
Dim LastDayTime As Double
FirstDayTime = DateDiff("n", StartDate, Month(StartDate) & "/" & Day(StartDate) & "/" & Year(StartDate) & " 05:00:00 PM") / 60
LastDayTime = DateDiff("n", Month(EndDate) & "/" & Day(EndDate) & "/" & Year(EndDate) & " 08:00:00 AM", EndDate) / 60
If LastDayTime < 0 Then LastDayTime = 0
If CDate(Month(StartDate) & "/" & Day(StartDate) & "/" & Year(StartDate)) = CDate(Month(EndDate) & "/" & Day(EndDate) & "/" & Year(EndDate)) Then
Workhours = DateDiff("n", StartDate, EndDate) / 60
Else:
Workhours = (Workdays(StartDate, EndDate) - 2) * 9 + FirstDayTime + LastDayTime
End If
If Workhours < 0 Then Workhours = 0
Workhours_Exit:
Exit Function
Workhours_Error:
Workhours = -1
MsgBox "Error " & Err.Number & ": " & Err.Description, vbCritical, "Workhours"
Resume Workhours_Exit
End Function
Public Function Weekdays(ByRef StartDate As Date, ByRef EndDate As Date) As Integer
' Returns the number of weekdays in the period from startDate
' to endDate inclusive. Returns -1 if an error occurs.
' If your weekend days do not include Saturday and Sunday and
' do not total two per week in number, this function will
' require modification.
On Error GoTo Weekdays_Error
' The number of weekend days per week.
Const ncNumberOfWeekendDays As Integer = 2
' The number of days inclusive.
Dim varDays As Variant
' The number of weekend days.
Dim varWeekendDays As Variant
' Temporary storage for datetime.
Dim dtmX As Date
' If the end date is earlier, swap the dates.
If EndDate < StartDate Then
dtmX = StartDate
StartDate = EndDate
EndDate = dtmX
End If
' Calculate the number of days inclusive (+ 1 is to add back startDate).
varDays = DateDiff(interval:="d", _
date1:=StartDate, _
date2:=EndDate) + 1
' Calculate the number of weekend days.
varWeekendDays = (DateDiff(interval:="ww", _
date1:=StartDate, _
date2:=EndDate) _
* ncNumberOfWeekendDays) _
+ IIf(DatePart(interval:="w", _
Date:=StartDate) = vbSunday, 1, 0) _
+ IIf(DatePart(interval:="w", _
Date:=EndDate) = vbSaturday, 1, 0)
' Calculate the number of weekdays.
Weekdays = (varDays - varWeekendDays)
Weekdays_Exit:
Exit Function
Weekdays_Error:
Weekdays = -1
MsgBox "Error " & Err.Number & ": " & Err.Description, _
vbCritical, "Weekdays"
Resume Weekdays_Exit
End Function
Public Function WorkHoursFormat(Start_Time As Date, End_Time As Date, Optional Stop_Time As Double = 0) As String
WorkHoursFormat = Format(Int(Workhours(DateAdd("n", Nz(Stop_Time), Start_Time), End_Time)), "00") & ":" & Format(Int((Workhours(DateAdd("n", Nz(Stop_Time), Start_Time), End_Time) * 3600 - (Int(Workhours(DateAdd("n", Nz(Stop_Time), Start_Time), End_Time)) * 3600)) / 60), "00") & ":" & Format(((Workhours(DateAdd("n", Nz(Stop_Time), Start_Time), End_Time) * 3600 Mod 60)), "00")
End Function
