Difference between date/time during working hours excluding weekends

**cec** · 04-11-2012, 01:00 PM

Hello I'm a newbie so let me know if this is possible:

Trying to figure out an exprisson on the difference between two dates(working hours). Here is my dilma...I have a Ord_Dt/Time , Recvd_Dt/Time and working hours 8am-8pm M-F. if i Ord_DT/Time = 4/6/12 11am and Recvd_Dt/Time =4/10/12 5pm it should be 30 hours i'm getting 20. I have all different formula and even have tried to write a code but just not that good yet..can someone please help me on this !

**June7** · 04-11-2012, 04:06 PM

The period crosses several days and you want to exclude the 12 hours between 8 PM and 8 AM of each night? I get 54 hours with:
DateDiff("h",#4/6/2012 11:00:00 AM#,#4/10/2012 5:00:00 PM#) - (DateDiff("d",#4/6/2012 11:00:00 AM#,#4/10/2012 5:00:00 PM#)) * 12

Show the code you have attempted.

EDIT: Oops, just noticed the weekend issue. Looks like ssanfu has it covered in next post.

**ssanfu** · 04-11-2012, 05:00 PM

So I think the following code should return the proper number of hours. It returns 30 hours
4/6 = 9 hrs
4/7 = 0 (wkend)
4/8 = 0 (wkend)
4/9 = 12 hrs
4/10 = 9 hrs
-----------
total 30 hours

I modified a function by Arvin Meyer that I found on "The Access Web" site.

Code:

Public Function WorkingHrs(StartDate As Date, EndDate As Date) As Integer
'....................................................................
' 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 between
'          8am and 8Pm
' Note that this function does not account for holidays.
'....................................................................
   On Error GoTo Err_WorkingHrs

   Dim intCount As Integer
   Dim tmp As Integer
   Dim dtStart As Date
   Dim dtEnd As Date
   Dim tmStart As Date
   Dim tmEnd As Date

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

   'skip the first day
   dtStart = dtStart + 1

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

      Select Case Weekday(dtStart)
         Case Is = 1, 7
            intCount = intCount
         Case Is = 2, 3, 4, 5, 6
            intCount = intCount + 1
      End Select
      dtStart = dtStart + 1
   Loop
   WorkingHrs = intCount * 12

   'first day hours
   WorkingHrs = WorkingHrs + DateDiff("h", tmStart, #8:00:00 PM#)

   'Last day hours
   WorkingHrs = WorkingHrs + DateDiff("h", #8:00:00 AM#, tmEnd)


Exit_WorkingHrs:
   Exit Function

Err_WorkingHrs:
   Select Case Err

      Case Else
         MsgBox Err.Description
         Resume Exit_WorkingHrs
   End Select

End Function

**cec** · 04-12-2012, 08:01 AM

Thanks to you both for helping!!!!!! I have saved it and in the control source I put = "the name of module" and it gives me a "#Name?" error message...what am I doing wrong????

**R_Badger** · 04-12-2012, 08:08 AM

It should be something along the lines of:

WorkingHrs([Ord_DT/Time],[Recvd_Dt/Time])

**ssanfu** · 04-12-2012, 08:35 AM

In addition to what cec posted, you should not have the name of the module the same name as any other object. Each object name must be unique.

**cec** · 04-12-2012, 09:06 AM

Nevermind...I GOT IT!!!!!...........THANK YOU SSANFU!!!!!!!!!!!!!!! WORKED LIKE A CHARM!!!!!!!!!!

**cec** · 04-12-2012, 09:07 AM

R_Badger just seen your post and that was it thanks for your response!!!!!

**ssanfu** · 04-13-2012, 11:12 AM

Here are the changes you requested.... returns hrs and mins (ie 29hrs 36mins)

Note the function name change.....

Code:

Public Function WorkingHrsMins(StartDate As Date, EndDate As Date) As String
'....................................................................
' Name:  WorkingHrsMins
' Inputs:   StartDate As Date & time
'              EndDate As Date & time
' Returns: String- number of hours & minutes 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

    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

    '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

    '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, #8:00:00 PM#)
    'Last day minutes
    intTotalMin = intTotalMin + DateDiff("n", #8:00:00 AM#, tmEnd)

    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

**cec** · 04-17-2012, 09:30 AM

I tried this with 4/17/12 10:00 am as Dt ord and 4/17/12 4:00 pm and it gives me 18hrs 0min it want count the same day time difference can you help on this?

**June7** · 04-17-2012, 12:17 PM

I modified ssanfu's code to handle the situation of 1 day period:

Code:

    If dtStart <> dtEnd Then
        '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, #8:00:00 PM#)
        'Last day minutes
        intTotalMin = intTotalMin + DateDiff("n", #8:00:00 AM#, tmEnd)
    Else
        intTotalMin = DateDiff("n", StartDate, EndDate)
    End If

**ssanfu** · 04-17-2012, 12:37 PM

Revised function to handle hours when start and end dates are the same date

Code:

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

**cec** · 04-18-2012, 08:46 AM

thanks so much for everyone's help.

**foyasoul** · 09-10-2013, 03:31 PM

Originally Posted by ssanfu

Revised function to handle hours when start and end dates are the same date

Code:

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

This post was a lifesaver! Thank you so much for those of you that dedicate your time to helping us beginners. I do have a question about the function above. I am receiving a negative value for one of the results when the values are as follows:

StartDate = 8/12/2013 8:37 PM
End Date = 8/13/2013 8:15:54 AM

The result equals -3 hrs -22 min, whereas is the result SHOULD BE 15 min. It appears the function is subtracting the difference between the cEndingTime and the tmEnd.

I only changed the cEndingTime to 5:00:00 PM. The cBeginingTime is still 8:00:00 AM.

Could you please modify the function to calculate correctly, or according to the result I am looking for? Please? Thank you so much!

**foyasoul** · 09-11-2013, 01:10 PM

Originally Posted by foyasoul

This post was a lifesaver! Thank you so much for those of you that dedicate your time to helping us beginners. I do have a question about the function above. I am receiving a negative value for one of the results when the values are as follows:

StartDate = 8/12/2013 8:37 PM
End Date = 8/13/2013 8:15:54 AM

The result equals -3 hrs -22 min, whereas is the result SHOULD BE 15 min. It appears the function is subtracting the difference between the cEndingTime and the tmEnd.

I only changed the cEndingTime to 5:00:00 PM. The cBeginingTime is still 8:00:00 AM.

Could you please modify the function to calculate correctly, or according to the result I am looking for? Please? Thank you so much!

I figured it out . . .

Difference between date/time during working hours excluding weekends

Thread Tools

Difference between date/time during working hours excluding weekends

Lifesaver

Figured it out . . .

Similar Threads

working out time difference

working out time difference

Calculate quarter excluding weekends and, if possible, holidays

DateDiff Excluding Weekends

Weekday excluding weekends

Posting Permissions