Working hours Problems

[Thepieman]

I am currently trying to build a database that calculates the actual working hours it takes to complete a job - so I need to exclude weekends and any time elapse between 6pm and 7.30am.

So for example a job registered 5pm today and cleared at 8.00am tomorrow would show a working time of 1.5 hours.

With a LOT of help I came up with the code below- which works fine if the jobs are cleared in the same day, otherwise ........

Can anyone help with the code ?




Option Compare Database
Option Explicit

'=============================================================================
' Query
'=============================================================================
Public Function GetWaitHours(ByVal pdteReceived As Date, _
ByVal pdteAdopted As Date) As Variant
Const dblcBusinessHours As Double = 10.5
Const tmecDayStart As Date = "7:30:00"
Const tmecDayEnd As Date = "18:00:00"

Dim dblStartHours As Double
Dim dblStopHours As Double
Dim dblReturnHours As Double

On Error GoTo HandleError

If TimeValue(pdteReceived) >= TimeValue(tmecDayStart) _
And TimeValue(pdteReceived) <= TimeValue(tmecDayEnd) _
And TimeValue(pdteAdopted) >= TimeValue(tmecDayStart) _
And TimeValue(pdteAdopted) <= TimeValue(tmecDayEnd) _
And TimeValue(pdteReceived) <= TimeValue(pdteAdopted) Then
dblStartHours = ((TimeValue(tmecDayEnd) - TimeValue(pdteReceived)) * 24)
dblStopHours = ((TimeValue(pdteAdopted) - TimeValue(tmecDayStart)) * 24)

If DateValue(pdteReceived) = DateValue(pdteAdopted) Then
dblReturnHours = (TimeSerial(Hour(pdteAdopted) - Hour(pdteReceived), _
Minute(pdteAdopted) - Minute(pdteReceived), 0) * 24)
Else
Dim cDay As Long
For cDay = CLng(Int(pdteReceived)) To CLng(Int(pdteAdopted))
If cDay = Int(pdteReceived) Then
dblReturnHours = dblReturnHours + dblStartHours
ElseIf cDay = Int(pdteAdopted) Then
dblReturnHours = dblReturnHours + dblStopHours
Else
If Weekday(cDay, vbSaturday) > 2 Then
dblReturnHours = dblReturnHours + dblcBusinessHours
End If
End If
Next cDay
End If
Else
MsgBox Prompt:="Passed dates outside of business hours.", _
Buttons:=vbOKOnly + vbInformation, _
Title:="Error GetWaitHours Function"
End If

ExitHere:
GetWaitHours = dblReturnHours
Exit Function

HandleError:
MsgBox Prompt:=Err.Number & ": " & Err.Description, _
Buttons:=vbOKOnly + vbInformation, _
Title:="Error GetWaitHours Function"
Resume ExitHere
End Function

 

[The_Doc_Man]

There are ways and then there are ways...

Some folks take the approach of defining work history as having discrete start-stop times for SESSIONS of work. They can put down job A and pick up job B (perhaps because A is blocked by a resource wait....)

So you would track work hours on a project as a separate table, where you have the project ID from the project table as a foreign key in the hours worked table. You would have something like

tblProject
fldPrjID, pk, autonumber (or something else if these have meaning)
fldPrjDescr, text, description of project,
etc. etc. etc.

tblHrsWorked
fldPrjID, fk, long, relationship many-to-one on tblProject:fldPrjID
fldWorkStart, date
fldWorkEnded, date
fldWhyEnded, integer or text code showing why work stopped when it did...

Possible codes would be End of shift, Resource wait, Completed, Revoked, Stopped by business rules (Priority), Stopped by business rules (Funding), Stopped because building burned down, etc. etc.

Then your project work load would be the sum of all hours worked as noted in the table. It means you have to log out of a project when you stop work on it, but then you need no math at all. Hours worked is the sum of the differences between the start and end times of each record. No sweat!

 

[LaBelette]

Try this :

Public Function WorkingHours(datBegin As Date, datEnd As Date) As Double
    ' Beginning and end of the day
    Const tmecDayStart As Date = "7:30:00"
    Const tmecDayEnd As Date = "18:00:00"
    
    Dim datTotalTime As Date      ' Running total of time worked
    datTotalTime = 0                ' Initialized at 0
    
    Dim datTest As Date             ' Variable to keep the date where calculating
    datTest = datBegin              ' Initialized as the beginning date

    ' If the first day begins before 7:30, make it 7:30
    If TimeValue(datTest) < tmecDayStart Then
        datTest = DateValue(datTest) + TimeValue(tmecDayStart)
    ' If the first day begins after 18:00, make it 7:30 tomorow
    ElseIf TimeValue(datTest) > tmecDayEnd Then
        datTest = DateValue(datTest + 1) + TimeValue(tmecDayStart)
    Else
        ' If the first day starts after 7:30 and before 18:00, make it 7:30
        '  and substract the difference to the running total
        datTotalTime = datTotalTime - (TimeValue(datTest) - TimeValue(tmecDayStart))
        datTest = DateValue(datTest) + TimeValue(tmecDayStart)
    End If
    
    ' For every date
    Do While DateValue(datTest) < DateValue(datEnd)
        ' Skip weekends
        If Weekday(datTest, vbMonday) <= 5 Then
            ' Adds a complete day
            datTotalTime = datTotalTime + (TimeValue(tmecDayEnd) - TimeValue(tmecDayStart))
        End If
        
        ' Iterate (adds a day)
        datTest = datTest + 1
    Loop
    
    ' Remove the time for the last incomplete day
    ' Skip the weekend
    If Weekday(datTest, vbMonday) <= 5 Then
        ' If the last day ends before 7:30, add nothing
        If TimeValue(datEnd) < tmecDayStart Then
            ' Do nothing
        ' If the last day ends after 18:00, add a day
        ElseIf TimeValue(datEnd) > tmecDayEnd Then
            ' Adds a complete day
            datTotalTime = datTotalTime + (TimeValue(tmecDayEnd) - TimeValue(tmecDayStart))
        ' The last day ends between 7:30 and 18:00, add the time worked
        Else
            datTotalTime = datTotalTime + (TimeValue(datEnd) - TimeValue(tmecDayStart))
        End If
    End If
    
    ' Returns the number of minutes divided by 60, so it gives the number of hours
    ' I didn't returned DateDiff("h", CDate(0), datTotalTime) because Datediff returns a long.
    WorkingHours = DateDiff("n", CDate(0), datTotalTime) / 60
End Function

See the comentaries for more details.
It returns the number of hours in a double format.
Ex.: 210,5 for 210 hours and 30 minutes.

If you find a bug in it, please tell me, since I just wrote that code for you and I may use it later!

 

[Psiren17]

Great code - further help please!

Hi, this piece of code works great and i have been able to adapt it to the working hours of my site.

However i also need to be able to take holidays and shutdowns out of the timings. I have a table called holidays with one field called HolDate. This field contains all of the dates of UK bank holidays and our company shutdowns in the format dd/mm/yyyy.

Can you help? I would really appreciate it.

Jules