Calculate Working Hours

I am creating a database and what I need is code to figure out working hours between a start date and end date minus weekends & holidays.  I am not familiar with how to get this to work using queries etc.  I found code below but do not know how to have this run and fill a field in the table for the form named StaplesTotalTime.  The fields for start and end date/time are StaplesOutStart and StaplesOutEnd.  Thanks for any help.
Public Function NetWorkhours(dteStart As Date, dteEnd As Date) As Single
 
Dim intGrossDays As Integer
Dim intGrossHours As Single
Dim dteCurrDate As Date
Dim i As Integer
Dim WorkDayStart As Date
Dim WorkDayend As Date
Dim nonWorkDays As Integer
Dim StartDayhours As Single
Dim EndDayhours As Single
 
NetWorkhours = 0
nonWorkDays = 0
 
'Calculate work day hours on 1st and last day
WorkDayStart = DateValue(dteEnd) + TimeValue("09:00am")
WorkDayend = DateValue(dteStart) + TimeValue("05:30pm")
StartDayhours = DateDiff("h", dteStart, WorkDayend)
EndDayhours = DateDiff("h", WorkDayStart, dteEnd)
 
'adjust for time entries outside of business hours
If StartDayhours < 0 Then StartDayhours = 0
If EndDayhours > 8.5 Then EndDayhours = 8.5
 
'Calculate total hours and days between start and end times
intGrossDays = DateDiff("d", (dteStart), (dteEnd))
intGrossHours = DateDiff("h", (dteStart), (dteEnd))
 
'count number of weekend days and holidays (from a table called "Holidays" that lists them)
For i = 0 To intGrossDays
        dteCurrDate = dteStart + i
        If Weekday(dteCurrDate, vbSaturday) < 3 Then
            nonWorkDays = nonWorkDays + 1
        Else
            If Not IsNull(DLookup("[HolDate]", "Holidays", "[HolDate] = #" & Int(dteCurrDate) & "#")) Then
                nonWorkDays = nonWorkDays + 1
            End If
        End If
 Next i
    
'Calculate number of work hours
Select Case intGrossDays
 Case 0   'start and end time on same day
    NetWorkhours = intGrossHours
 Case 1   'start and end time on consecutive days
    NetWorkhours = NetWorkhours + StartDayhours
    NetWorkhours = NetWorkhours + EndDayhours
 Case Is > 1  'start and end time on non consecutive days
    NetWorkhours = NetWorkhours - (nonWorkDays * 24)
    NetWorkhours = (intGrossDays - 1 - nonWorkDays) * 8.5
    NetWorkhours = NetWorkhours + StartDayhours
    NetWorkhours = NetWorkhours + EndDayhours
 End Select
 
End Function

Open in new window

Cody VanceSr. Analyst - ERPAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Patrick MatthewsCommented:
Hello codyvance1,

I use this function to calculate working time.  Assuming you have a holidays table...

SELECT StartAt, EndAt, WorkingHrsHolTbl(StartAt, EndAt, #8:00 AM#, #6:00 PM#, "23456", "tblHolidays", "HolidayDt")
FROM SomeTable

Regards,

Patrick
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

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Patrick MatthewsCommented:
I object.  I provided working code that I frequently use myself, and showed an example of how to use it in the query in my comment #24495324.

If the code did not do exactly what you had in mind, all you would have had to do is provide some feedback--any feedback!--to that effect.

Patrick
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Access

From novice to tech pro — start learning today.