Elapsed time hrs mins secs

[June7]

Should include Option Explicit at the top of every code module. This will help catch some errors with spelling of variable names and variables that have not been declared.

The function does not error with all 3 data examples provided. However, the third example does not return elapsed time because end time is after 8pm.

Provide an example that causes the overflow error.

Review http://bytes.com/topic/access/answer...idays-weekends

If you have additional requirement to exclude records that have a begin or end time between 8pm and 8am, that does complicate.

[dasousa]

28-04-2015 20:01:42 28-04-2015 20:03:37
28-04-2015 19:58:52 28-04-2015 20:00:27
24-04-2015 13:07:54 28-04-2015 23:17:25

all this 3 examples causes overflow


I have attach my database, if you open query1 you will see that overflow examples
I also attach a excel file with the correct values that should be the correct

thanks for all the help

[June7]

All 3 records have a begin and/or end time that is after 8pm and therefore cause procedure exit.


Do you really need this down to the seconds?


This runs without error. Note that I commented out the code that causes early exit.

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 intSeconds As Integer
Dim lngTotalSecs As Long
Dim dtStart As Date
Dim dtEnd As Date
Dim dtTemp As Date
Dim tmStart As Date
Dim tmEnd As Date
intMinutes = 0
intHours = 0
intSeconds = 0
lngTotalSecs = 0
intCountDays = 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
   lngTotalSecs = DateDiff("s", 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
   intHours = intCountDays * 720
   'first day minutes
   lngTotalSecs = lngTotalSecs + DateDiff("s", tmStart, cEndingTime)
   'Last day minutes
   lngTotalSecs = lngTotalSecs + DateDiff("s", cBeginingTime, tmEnd)
End If
intHours = intHours + lngTotalSecs \ 3600   'hours
intMinutes = Format(Int((lngTotalSecs Mod 3600) / 60), "00") 'minutes
intSeconds = Format(Int((lngTotalSecs Mod 3600) Mod 60), "00") 'seconds
'return value
WorkingHrsMinsSecs = intHours & ":" & intMinutes & ":" & intSeconds

The 'correct' calcs in the Excel are not associated with the right data - they are off by one line.


Advise not to use spaces and special characters/punctuation (underscore is exception) in naming convention.

[dasousa]

Hello June

It's better but there are error in calc when the hours are in the 20PM-8AM
I match the result from access to the xls file .

Sorry for all the trouble, and thanks for all the help but i'm not very expert with this

My objective is to have a total of hh:mm:ss passed only during a time period (8:00AM to 8:00PM) and without weekends. Like a SLA that only is valid for Monday to Friday during the 8AM to 8PM

Reported Date+	Last Resolved Date	Funcion	Correct value
28-4-15 12:55	29-4-15 22:29	21:34:1	19:04:55
28-4-15 12:36	29-4-15 22:30	21:53:20	19:23:03
27-4-15 16:27	29-4-15 22:05	737:38:35	27:32:46
27-4-15 16:23	28-4-15 23:25	19:2:25	15:36:30
27-4-15 16:12	29-4-15 21:47	737:35:25	27:47:32
27-4-15 15:19	28-4-15 23:42	20:23:14	16:40:50
27-4-15 14:27	29-4-15 22:33	740:5:56	29:32:52
27-4-15 14:20	28-4-15 23:43	21:23:40	17:39:59
27-4-15 14:46	29-4-15 22:27	739:40:59	29:13:20
27-4-15 13:10	29-4-15 22:25	741:15:1	30:49:06
27-4-15 10:28	28-4-15 23:26	24:58:28	21:31:40

[June7]

Const cBeginTime As Date = #8:00:00 AM#
Const cEndTime As Date = #8:00:00 PM#
Dim intCountDays As Integer
Dim intHours As Integer
Dim intMinutes As Integer
Dim intSeconds As Integer
Dim lngTotalSecs As Long
Dim dtStart As Date
Dim dtEnd As Date
Dim dtTemp As Date
Dim tmStart As Date
Dim tmEnd As Date
intMinutes = 0
intHours = 0
intSeconds = 0
lngTotalSecs = 0
intCountDays = 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 And (tmStart > cEndTime Or tmEnd < cBeginTime) Then
    WorkingHrsMinsSecs = "0:0:0"
Else
    'adjust times if before or after 8am and 8pm
    If tmStart < cBeginTime Then tmStart = DateAdd("s", DateDiff("s", tmStart, cBeginTime), tmStart)
    If tmEnd > cEndTime Then tmEnd = DateAdd("s", -1 * DateDiff("s", cEndTime, tmEnd), tmEnd)
     
    If dtStart = dtEnd Then
       lngTotalSecs = DateDiff("s", 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
       intHours = intCountDays * 720
       'first day minutes
       lngTotalSecs = lngTotalSecs + DateDiff("s", tmStart, cEndTime)
       'Last day minutes
       lngTotalSecs = lngTotalSecs + DateDiff("s", cBeginTime, tmEnd)
    End If
    intHours = intHours + lngTotalSecs \ 3600   'hours
    intMinutes = Format(Int((lngTotalSecs Mod 3600) / 60), "00") 'minutes
    intSeconds = Format(Int((lngTotalSecs Mod 3600) Mod 60), "00") 'seconds
    'return value
    WorkingHrsMinsSecs = intHours & ":" & intMinutes & ":" & intSeconds
End If

[Missinglinq]

but when i have more than 1 day of difference it gives "overflow" (

Overflow error means that you're trying to assign a number to a variable with a Datatype that is too small to handle it. Modify your Dim statement

Dim intTotalSec As Integer

changing Integer to Long.

Dim intTotalSec As Long

Linq ;0)>