calculate hours excluding weekends

[Jaye7]

I found the following function on the net to calculate hours between 2 dates (EXCLUDING WEEKENDS).

The problem I am having is that it is returning 44 hours between the following dates where it should be 20-21 hours.

StartDate: 29/04/2016 2:54:53 PM
EndDate: 2/05/2016 11:18:21 AM

Looking at the calendar there would be around 9-10 hours on 29th from 2pm-12pm, no hours on Sat 30th APRIL or Sun 1st MAY, then 11 hours on 2nd May.

It looks like it is including 1 of the weekend days which would be 20+ 24 =44

Public Function WorkingHrsMins(StartDate As Date, EndDate As Date) As String
'....................................................................
' Name:  WorkingHrs
' Inputs:   StartDate As Date & time
'  EndDate As Date & time
' Returns: Integer - number of hours not inclusive of weekends
' Author: Arvin Meyer
' Date:  February 19, 1997
' Modified by Steve S (ssanfu)
' Date: April 11, 2012
' Comment: Accepts two dates and returns the number
' of work hours and minutes between 8am and 8pm
' Note that this function does not account for holidays.
'....................................................................
   On Error GoTo Err_WorkingHrs

   Const cBeginingTime As Date = #8:00:00 AM#
   Const cEndingTime As Date = #8:00:00 PM#

   Dim intCountDays As Integer
   Dim intHours As Integer
   Dim intMinutes As Integer
   Dim intTotalMin As Integer
   Dim dtStart As Date
   Dim dtEnd As Date
   Dim dtTemp As Date
   Dim tmStart As Date
   Dim tmEnd As Date

   intMinutes = 0
   intHours = 0
   intCountDays = 0
   intTotalMin = 0
   WorkingHrsMins = 0

   'check end date > start date
   If EndDate < StartDate Then
      dtTemp = StartDate
      StartDate = EndDate
      EndDate = dtTemp
   End If

   'get just the date portion
   dtStart = Int(StartDate)
   dtEnd = Int(EndDate)
   'get just the time portion
   tmStart = StartDate - dtStart
   tmEnd = EndDate - dtEnd

   'check start and end times are valid
   If Not (tmStart >= cBeginingTime And tmStart <= cEndingTime) Then
      MsgBox "Invalid start time. Start time before " & cBeginingTime
      Exit Function
   ElseIf Not (tmEnd >= cBeginingTime And tmEnd <= cEndingTime) Then
      MsgBox "Invalid end time. End time after " & cEndingTime
      Exit Function
   End If

   If dtStart = dtEnd Then
      intTotalMin = DateDiff("n", tmStart, tmEnd)
   Else
      'skip the first day
      dtStart = dtStart + 1

      Do While dtStart < dtEnd
         'Make the above < and not <= to not count the EndDate

         Select Case Weekday(dtStart)
            Case Is = 1, 7
               'do nothing
            Case Is = 2, 3, 4, 5, 6
               intCountDays = intCountDays + 1
         End Select
         dtStart = dtStart + 1
      Loop
      intTotalMin = intCountDays * 720

      'first day minutes
      intTotalMin = intTotalMin + DateDiff("n", tmStart, cEndingTime)
      'Last day minutes
      intTotalMin = intTotalMin + DateDiff("n", cBeginingTime, tmEnd)


   End If
   intHours = intTotalMin \ 60   'hours
   intMinutes = intTotalMin Mod 60   'minutes

   'return value
   WorkingHrsMins = intHours & " hrs  " & intMinutes & " min"

Exit_WorkingHrs:
   Exit Function

Err_WorkingHrs:
   Select Case Err

      Case Else
         MsgBox Err.Description
         Resume Exit_WorkingHrs
   End Select

End Function

 

[GinaWhipp]

Not sure I understand because the Function only calculates between 8:00 AM and 8:00 PM, (5 hours from the 29th and 3 hours from the 2nd) so, it should be returning 8 hours 24 minutes. Not sure how you are getting 44 hours, so something else going on.

 

[sneuberg]

When I try this with those dates and times I get 8 hrs 24 mins which is correct considering the following constants in the code.

  Const cBeginingTime As Date = #8:00:00 AM#
   Const cEndingTime As Date = #8:00:00 PM#

I don't know is it makes a difference but I used American dates in my function call it was:

Debug.Print WorkingHrsMins(#4/29/2016 2:54:53 PM#, #5/2/2016 11:18:21 AM#)

If I change the constants to:

Const cBeginingTime As Date = #12:00:01 AM#
Const cEndingTime As Date = #11:59:59 PM#

I get 20 hrs 23 min

 

[sneuberg]

While it has nothing to do with the problem at hand I suggest changing the Integers in this code to Longs to avoid overflow errors with dates that span more time.

The other thing to note about this code is that if the start date is after the end date it merely swaps them rather than flagging it as an error.

 

[Jaye7]

Thanks, I was getting an overflow error when I tried to re-run it in another database, I will check the code out when I get back to work on Monday.

 

[plog]

I suggest scrapping that code all together. I don't know your level of VBA coding, but this would be a good beginner project--its a pretty simple project when you think about it.

Here's some psuedo code to show how I would tackle it:

get_WorkingHours(in_Start, in_End)

if in_Start occurs on Saturday or Sunday, set it to Monday at midnight (beginning of Monday)
if in_End occurs on Saturday or Sunday, set it to Friday at 11:59
dim ret = Difference in hours beteween in_Start and in_End
Use a datedifference to see how many weeks in_Start to in_End span
subtract 48 from ret for every week that occurs

return ret