Custom Function Help - Business Hours

[Carbja23]

Afternoon All,

I've been looking at code posted on the forums in 2005, however the user has not been active since 2012. Looking to try and figure out why I don't get a correct answer when running the function. I've been staring at it for quite some time now to try and see the issue with no luck. Anyone able decipher why? I'm pretty good with VBA, but custom functions involving time is a bit much for my skill level.

I've edited the function to use an example of two dates, however your database will need a holiday table with the field HOLDATE in it to run properly.

USER PSIREN17 posted this code at this link originally.

(Linked Removed as you need > 10 posts)

Public Function NetWorkhours()

'(dteStart As Date, dteEnd As Date) As Single

''''''''''''''''''''''''''''''''''''''
' CODE TAKEN FROM: LINK REMOVED  < 10 POSTS
' USER: PSIREN17
'
'
''''''''''''''''''''''''''''''''''''''

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

''''''''''''''''''''''''''''''''''''''
'USE THIS TO TEST OUT THE FUNCTION
''''''''''''''''''''''''''''''''''''''

Dim dteStart As Date
Dim dteEnd As Date
dteStart = "9/15/2015 8:33:23 AM"
dteEnd = "9/17/2015 8:29:58 AM"

''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''



NetWorkhours = 0
nonWorkDays = 0
'Calculate work day hours on 1st and last day

WorkDayStart = DateValue(dteEnd) + TimeValue("08:00am")
WorkDayend = DateValue(dteStart) + TimeValue("06:00pm")
StartDayhours = DateDiff("n", dteStart, WorkDayend)
EndDayhours = DateDiff("n", WorkDayStart, dteEnd)
'adjust for time entries outside of business hours

If StartDayhours < 0 Then
StartDayhours = 0
End If
If EndDayhours > 8 Then
EndDayhours = 8
End If

'Calculate total hours and days between start and end times

intGrossDays = DateDiff("d", (dteStart), (dteEnd))
intGrossHours = DateDiff("n", (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 * 1)
NetWorkhours = (intGrossDays - nonWorkDays) * 8
NetWorkhours = NetWorkhours + StartDayhours
NetWorkhours = NetWorkhours + EndDayhours

Debug.Print NetWorkhours / 60


End Select

End Function

 

[Carbja23]

Wow I didn't find the original post the code came from. I'll definitely check that out.

Thank You!

JC

 

[Carbja23]

I grabbed the 3rd database from the forum posts. I don't think I've ever seen a boolean in a custom function. What should that value in the formula be set at?

If set to Zero I begin to get negative values for time.

Option Compare Database

Public Function NetWorkhours()

'(dteStart As Date, dteEnd As Date, Spellout As Boolean) As Variant

''''''''''''''''''''''''''''''''''''''
' CODE TAKEN FROM: Link Removed
' USER: PSIREN17
'
'
''''''''''''''''''''''''''''''''''''''

Dim intGrossDays As Integer
Dim intGrossMins As Single
Dim dteCurrDate As Date
Dim i As Integer
Dim WorkDayStart As Date
Dim WorkDayend As Date
Dim nonWorkDays As Integer
Dim StartDayMins As Single
Dim EndDayMins As Single
Dim NetworkMins As Integer
NetworkMins = 0
nonWorkDays = 0
'Calculate work day hours on 1st and last day

''''''''''''''''''''''''''''''''''''''
'USE THIS TO TEST OUT THE FUNCTION
''''''''''''''''''''''''''''''''''''''

Dim dteStart As Date
Dim dteEnd As Date
dteStart = "4/8/2015 8:34:00 PM"
dteEnd = "4/9/2015 8:08:59 AM"

''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''


WorkDayStart = DateValue(dteEnd) + TimeValue("09:00:00")
WorkDayend = DateValue(dteStart) + TimeValue("17:00:00")
StartDayMins = DateDiff("n", dteStart, WorkDayend)
EndDayMins = DateDiff("n", WorkDayStart, dteEnd)
'adjust for time entries outside of business hours


'Calculate total hours and days between start and end times

intGrossDays = DateDiff("d", (dteStart), (dteEnd))
intGrossMins = DateDiff("n", (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
        NetworkMins = (intGrossMins - ((nonWorkDays) * 1440))
    Case 1
        'start and end time on consecutive days
        NetworkMins = StartDayMins + EndDayMins
    Case Is > 1
        'start and end time on non consecutive days
        NetworkMins = (((intGrossDays - 1) - nonWorkDays) * 480) + (StartDayMins + EndDayMins)
    
    End Select
    If Spellout = True Then
        NetWorkhours = MinsToTime(NetworkMins) ' hours and mins
    Else
        NetWorkhours = NetworkMins ' minutes only
    End If
    
    Debug.Print NetWorkhours
    
    
End Function


Function MinsToTime(Mins As Integer) As String
    MinsToTime = Mins \ 60 & " hour" & IIf(Mins \ 60 <> 1, "s ", " ") & Mins Mod 60 & " minute" & IIf(Mins Mod 60 <> 1, "s", "")
End Function

Debug.print Networkhours = - 266