Calculate no. of hours at a time of day

Hi there - I wrote this code this AM to answer another access question (Calling all code masters) and I think it may be what you want. I have modified slightly to fit your needs. You will need a table called BankHoliday with one field, date, format dd/mm/yyyy called HolidayDate. This should contain the holidays ;-)

Public Function BookedHours(StartTime As String, StartDate As String, EndTime As String, EndDate As String) As Long

'   constants that indicate the working day
     
    Const WORKING_DAY_START = "08:00"
    Const WORKING_DAY_END = "16:00"
         
'   misc temp variables
     
    Dim intMinutes As Integer
    Dim intHours As Integer
    Dim intDays As Integer
     
    Dim HOURS_IN_DAY As Integer
    Dim MINUTES_IN_DAY As Integer
     
    Dim booInd As Boolean
    Dim intCount As Integer
    Dim intResult As Integer
    Dim snpCheck as recordset
     
    intMinutes = 0
    intHours = 0
    intDays = 0
         
    HOURS_IN_DAY = DateDiff("h", WORKING_DAY_START, WORKING_DAY_END)
    MINUTES_IN_DAY = DateDiff("m", WORKING_DAY_START, WORKING_DAY_END)
     
         
'   work out the number of days excluding weekends
     
    For intCount = 0 To DateDiff("d", StartDate, EndDate) - 1
         
        intResult = WeekDay(DateAdd("d", intCount, StartDate))
        If intResult <> vbSunday And intResult <> vbSaturday Then
           set snpCheck = currentdb().openrecordset("Select * From BankHoliday WHere HolidayDate = #" & DateAdd("d", intCount, StartDate) & "#", dbopensnapshot)      
           if snpcheck.recordcount = 0 then
           intDays = intDays + 1
          end if
          snpcheck.close
        End If
         
    Next
     
    intDays = intDays - 1
     
'   work out the number of hours, bearing in mind we alreayd have the number of days
     
    If StartDate <> EndDate Then    '   we spread over days

'   workout hours on first day
         
        intHours = intHours + DateDiff("h", StartTime, WORKING_DAY_END)
        intMinutes = intMinutes + DateDiff("n", StartTime, WORKING_DAY_END) Mod 60
         
'   workout hours on last day
         
        intHours = intHours + DateDiff("h", WORKING_DAY_START, EndTime)
        intMinutes = intMinutes + DateDiff("n", WORKING_DAY_START, EndTime) Mod 60
         
    '   any days in between?
         
        If intDays > 2 Then
         
            intHours = intHours + ((intDays - 1) * HOURS_IN_DAY)
            intMinutes = intMinutes + ((intDays - 1) * (MINUTES_IN_DAY Mod 60))
         
        End If
         
    Else    '   we are on the same day
        intHours = DateDiff("h", StartTime, EndTime)
        intMinutes = DateDiff("n", StartTime, EndTime) Mod 60
         
        If intMinutes > 0 And intHours > 1 Then
            intHours = intHours - 1
        End If
         
    End If
     
'   finally, tidy up the result
     
    If intHours >= HOURS_IN_DAY Then '   add to the days
     
        intDays = intDays + (intHours / HOURS_IN_DAY)
        intHours = intHours Mod HOURS_IN_DAY
     
    End If
     
    If intMinutes >= 60 Then '   add to the days
     
        intHours = intHours + (intMinutes / 60)
        intMinutes = intMinutes Mod 60
     
    End If
     
    BookedHours = CStr((intDays*HOURS_IN_DAY)+intHours)& " hours, " & CStr(intMinutes) & " minutes"
         
End Function

HTH

Simon

Whoops - that shoud be

Public Function BookedHours(StartTime As String, StartDate As String, EndTime As String, EndDate As String) As String

 - to get a numeric result back (in minutes), keep the

Public Function BookedHours(StartTime As String, StartDate As String, EndTime As String, EndDate As String) As Long

and change

BookedHours = CStr((intDays*HOURS_IN_DAY)+intHours)& " hours, " & CStr(intMinutes) & " minutes"

To

BookedHours = (((intDays*HOURS_IN_DAY)+intHours)*60) + intMinutes

HTH

Simon

Interesting... Grizzle has a similar problem in Q10314464 (https://www.experts-exchange.com/jsp/qShow.jsp?ta=msaccess&qid=10314464 ).
I'll offer to you, as I did to him, the opportunity for me to e-mail a solution I engineered recently.  (I haven't sent it to him yet, either, as I haven't gotten enough time to extract the functionality from the other app into a new, stand-alone mdb yet...)
inimeq: If you are interested in seeing my solution, let me know in this forum.
Experts: Yes, I'll clue y'all in on how it works!

Simonbennet:

Your solution is pretty slick and straightforward.  In fact, I swiped it...

I modified your function to fit an application I'm working on.  I changed it so that it accepts two date values: dtmStart and dtmEnd.  Then in the function I calculate StartTime, StartDate, EndTime, and EndDate.

I gained a slight improvement in speed (I'm running this in a query with thousands of records) by changing the 4 string variables to dates.

Wes

Wes - yup I thought of that but being hungover couldn't be arsed.

I'll answer this one....just for attention mind....

Hi Simon

I haven't forgotten about the question. I've been so busy meeting other project deadlines.  :-(

As yet I haven't had the chance to evaluate the answer you provided.

I don't doubt it's "correctness" but I'd like to test it before I close the question off.

I'll tackle it the weekend :-)

Regards,
inimeg

Sorry matey.

Don't forget to enjoy yourself over the weekend as well.

I finally had a chance to run your function :-)

I get my input values, StartDate and EndDate, from a screen. The screen has a command button which, when clicked, passes these values to your function.

I entered the following values:
StartDate: 17/03/2000 09:00
EndDate  : 17/03/2000 13:00

The answer I get for BookedHours = -240 which should actually be 4.

Is there a step of code missing or a check that must be built in?

Maybe I'm doing something wrong. Should the check for "on the same day" be before the For ...next loop?

The code does not pick up the Working End Time (e.g. 16:00)

If I enter an End Time of 17h00 with a Start Time of 09h00 for the same day, the BookedHours = 8 instead of 7.

Help ... whats wrong?

Who are you talking to? :-)

I'm referring to the code provided by simonbennett.

I did send you e-mail, Beliver w.r.t. this question.

If you used the code exactly as it appears you can't feed it an end time past 16:00.  That is the end of the workday so any time/date outside of the valid workdays will fail.

I don't want to step on SimonBennett's toes, but here's my modified version of his code.  I think the original had problems with times on the same date:

Public Function WorkMinutes(dtmStart As Date, dtmEnd As Date) As Long

'   constants that indicate the working day
     
    Const WORKING_DAY_START = "8:00"
    Const WORKING_DAY_END = "17:30"
         
'   misc temp variables
     
    Dim intMinutes As Integer
    Dim intHours As Integer
    Dim intDays As Integer
     
    Dim HOURS_IN_DAY As Integer
    Dim MINUTES_IN_DAY As Integer
     
    Dim booInd As Boolean
    Dim intCount As Integer
    Dim intResult As Integer
    Dim snpCheck As Recordset
     
    intMinutes = 0
    intHours = 0
    intDays = 0

    Dim StartTime As Date, StartDate As Date, EndTime As Date, EndDate As Date
   
    StartTime = TimeValue(dtmStart)
    StartDate = DateValue(dtmStart)
    EndTime = TimeValue(dtmEnd)
    EndDate = DateValue(dtmEnd)
   
    HOURS_IN_DAY = DateDiff("h", WORKING_DAY_START, WORKING_DAY_END)
    MINUTES_IN_DAY = DateDiff("m", WORKING_DAY_START, WORKING_DAY_END)
     
         
'   work out the number of days excluding weekends
     
    For intCount = 0 To DateDiff("d", StartDate, EndDate) - 1
         
        intResult = WeekDay(DateAdd("d", intCount, StartDate))
        If intResult <> vbSunday And intResult <> vbSaturday Then
           Set snpCheck = CurrentDb().OpenRecordset("Select * From Holiday WHere HolidayDate = #" & DateAdd("d", intCount, StartDate) & "#", dbOpenSnapshot)
           If snpCheck.RecordCount = 0 Then
           intDays = intDays + 1
          End If
          snpCheck.close
        End If
         
    Next
     
   
     
'   work out the number of hours, bearing in mind we already have the number of days
     
    If StartDate <> EndDate Then    '   we spread over days
        intDays = intDays - 1
'   workout hours on first day
         
        intHours = intHours + DateDiff("h", StartTime, WORKING_DAY_END)
        intMinutes = intMinutes + DateDiff("n", StartTime, WORKING_DAY_END) Mod 60
         
'   workout hours on last day
         
        intHours = intHours + DateDiff("h", WORKING_DAY_START, EndTime)
        intMinutes = intMinutes + DateDiff("n", WORKING_DAY_START, EndTime) Mod 60
         
    '   any days in between?
         
        If intDays > 0 Then
         
            intHours = intHours + ((intDays - 1) * HOURS_IN_DAY)
            intMinutes = intMinutes + ((intDays - 1) * (MINUTES_IN_DAY Mod 60))
         
        End If
         
    Else    '   we are on the same day
        intHours = DateDiff("h", StartTime, EndTime)
        intMinutes = DateDiff("n", StartTime, EndTime) Mod 60
         
        If intMinutes > 0 And intHours > 1 Then
            intHours = intHours - 1
        End If
         
    End If
     
'   finally, tidy up the result
     
    If intHours >= HOURS_IN_DAY Then '   add to the days
     
        intDays = intDays + (intHours / HOURS_IN_DAY)
        intHours = intHours Mod HOURS_IN_DAY
     
    End If
     
    If intMinutes >= 60 Then '   add to the days
     
        intHours = intHours + (intMinutes / 60)
        intMinutes = intMinutes Mod 60
     
    End If
     
    'BookedHours = CStr((intDays * HOURS_IN_DAY) + intHours) & " hours, " & CStr(intMinutes) & " minutes"
    WorkMinutes = (((intDays * HOURS_IN_DAY) + intHours) * 60) + intMinutes
End Function

Wes

StartDate and StartTime should be one parameter i.e. the StartDate should include the Date and Time .... likewise for the EndDate and EndTime.

I don't know if it should be broken up for the calculation because I don't seem to be getting the correct result.

I could possibly e-mail my little database if anyone is interested to see what's going on with my code.

inimeg:

The function I posted accepts just two arguments: dtmStart As Date, dtmEnd As Date.  

"StartDate and StartTime should be one parameter i.e. the StartDate should include the Date and Time .... likewise for the EndDate and EndTime. "  You do include the startdate and starttime within the same parameter, i.e. #3/21/2000 8:00:00 AM#

Wes

inimeq: I think I e-mailed you my solution... did you get it?  Have time to look over it?  

Believer, I did get you solution ... must still evaluate.

Wes ... I'm looking at your as well.

o'tay!...

Wes and Simon

I must allow the calculation to accomodate times outside the valid working time. It is crucial that the time the fault is open reflects the correct number of hours and not include the time that people don't work.

Here's an example ...

Let's say a fault is booked on the system on 17 March 2000 at 09H00.
There is a public holiday on 21 March 2000. Working hours for staff, to fix the problem, is between 08h00 to 16h00 for each day, except Saturday and Sunday and public holidays.

The user draws a report on 22 March 2000 at 14h00 to see how long this fault is open.

The total hours that the fault is open is 21 hours.
Here's how I derived that answer ...
Remember WorkStartTime = 08h00 WorkEndTime = 16h00

From 17/03/2000 09h00 To 17/03/2000 16h00 = 7hrs
The 18 & 19 March 2000 is over weekend so those hours are excluded.
From 20/03/2000 09h00 to 20/03/2000 16h00 = 8hrs
The 21 March 2000 is a public holiday so those hours are excluded.
From 22/03/2000 08h00 to 22/03/2000 14h00 = 6hrs

So number of hours that fault is open = 21 hrs.

Currently the code above does not calculate it in this way, so I can't award any points. Please ... how do I modify the code?

inimeg

Adjusted points from 100 to 200

Believer, your sample solution is too complexed for what I want to do .. too many parameters :-(

Is there no way it can be simplified to cover what I noted above.

The code provided by simonbennett is sooo close, I'm sure it just has to be adapted accordingly.

As an incentive to come up with code that satisfies my requirements 100% ... I'll increase the points to 200 :-)

inimeg,

I think I have it! After hours of research at my secret Bay location research center I have come up with the followinf function. I believe the problem was down to the fact that it 'cared' about the number of days. Try this one (and don't forget to create a table called BankHoliday containing one field called HolidayDate!)...

Public Function BookedHours(StartTime As String, StartDate As String, EndTime As String, EndDate As String) As String

'   constants that indicate the working day
     
    Const WORKING_DAY_START = "08:00"
    Const WORKING_DAY_END = "16:00"
         
'   misc temp variables
     
    Dim intMinutes As Integer
    Dim intHours As Integer
    Dim intDays As Integer
     
    Dim HOURS_IN_DAY As Integer
    Dim MINUTES_IN_DAY As Integer
     
    Dim booInd As Boolean
    Dim intCount As Integer
    Dim intResult As Integer
    Dim snpCheck As Recordset
     
    intMinutes = 0
    intHours = 0
    intDays = 0
         
    HOURS_IN_DAY = DateDiff("h", WORKING_DAY_START, WORKING_DAY_END)
    MINUTES_IN_DAY = DateDiff("m", WORKING_DAY_START, WORKING_DAY_END)
     
         
'   work out the number of days excluding weekends
     
    For intCount = 0 To DateDiff("d", StartDate, EndDate) - 1
         
        intResult = WeekDay(DateAdd("d", intCount, StartDate))
        If intResult <> vbSunday And intResult <> vbSaturday Then
           Set snpCheck = CurrentDb().OpenRecordset("Select * From BankHoliday WHere HolidayDate = #" & DateAdd("d", intCount + 1, StartDate) & "#", dbOpenSnapshot)
           If snpCheck.RecordCount = 0 Then
           intDays = intDays + 1
          End If
          snpCheck.Close
        End If
         
    Next
     
    intDays = intDays - 1
     
'   work out the number of hours, bearing in mind we alreayd have the number of days
     
    If StartDate <> EndDate Then    '   we spread over days

'   workout hours on first day
         
        intHours = intHours + DateDiff("h", StartTime, WORKING_DAY_END)
        intMinutes = intMinutes + DateDiff("n", StartTime, WORKING_DAY_END) Mod 60
         
'   workout hours on last day
         
        intHours = intHours + DateDiff("h", WORKING_DAY_START, EndTime)
        intMinutes = intMinutes + DateDiff("n", WORKING_DAY_START, EndTime) Mod 60
         
    '   any days in between?
         
        If intDays >= 1 Then
         
            intHours = intHours + ((intDays) * HOURS_IN_DAY)
            'intMinutes = intMinutes + ((intDays) * (MINUTES_IN_DAY Mod 60))
         
        End If
         
    Else    '   we are on the same day
        intHours = DateDiff("h", StartTime, EndTime)
        intMinutes = DateDiff("n", StartTime, EndTime) Mod 60
         
        If intMinutes > 0 And intHours > 1 Then
            intHours = intHours - 1
        End If
         
    End If
     
'    If intHours >= HOURS_IN_DAY Then '   add to the days
'
'        intDays = intDays + (intHours / HOURS_IN_DAY)
'        intHours = intHours Mod HOURS_IN_DAY
'
    'End If
     
    If intMinutes >= 60 Then '   add to the days
     
        intHours = intHours + (intMinutes / 60)
        intMinutes = intMinutes Mod 60
     
    End If
     
    BookedHours = CStr(intHours) & " hours, " & CStr(intMinutes) & " minutes"
         
End Function


HTH

Simon

SimonBennett

I'm still experiencing hiccups. I evaluated your code with the example I used above. I get 29hrs.

Can't I e-mail my sample database to you to have a look at.

.... you're getting closer with the solution .. I'd say 95% :-)

.ok - and yopu had a record in the holiday table? - Sorry just had to check.

Working......

Yes ... I have entered 21 March 2000 as a record in the holiday table.

inimeg

Hello again...

When I run the function here from the debug window this is the result...

?bookedhours("09:00","17/03/2000","14:00","22/03/2000")
21 hours, 0 minutes

...honest!

inimeg - can you do me a favour and set a breakpoint on this line:

If snpCheck.RecordCount = 0 Then

Press F8 to step through and you can see if it picks up the date from the table (I have a feeling that the dates are mismatching due to formatting). If it enters the IF and runs the...

intDays = intDays + 1

...line *twice* (for this example), try changing this line:

Set snpCheck = CurrentDb().OpenRecordset("Select * From BankHoliday WHere HolidayDate = #" & DateAdd("d", intCount + 1, StartDate) & "#", dbOpenSnapshot)

...to..

Set snpCheck = CurrentDb().OpenRecordset("Select * From BankHoliday WHere HolidayDate = #" & format(DateAdd("d", intCount + 1, StartDate),"dd/mm/yyyy") & "#", dbOpenSnapshot)

...and if that fails, your regoinal setting are different from mine, so try..

Set snpCheck = CurrentDb().OpenRecordset("Select * From BankHoliday WHere HolidayDate = #" & format(DateAdd("d", intCount + 1, StartDate),"mm/dd/yyyy") & "#", dbOpenSnapshot)

Good Luck

Simon

Yes ... I have entered 21 March 2000 as a record in the holiday table.

inimeg

Is that a comment or is there a bug here??

How did the code go?

Simon,

Still no luck .. I've changed the line of code as you suggested with both formats (dd/mm/yyyy and mm/dd/yyyy).
I still get 29hrs instead of 21hrs.

Let me know if I can e-mail my sample to you.

..or you can email the DB to me on

simonpbennett@torontosoftware.freeserve.co.uk

Simon

better still (as that is my home email and I can't reply for about 9hrs)post your email so I can send a blank mesage for you to reply to - trust me, my address is a killer....

Simon

Simon,

Still no luck .. I've changed the line of code as you suggested with both formats (dd/mm/yyyy and mm/dd/yyyy).
I still get 29hrs instead of 21hrs.

Let me know if I can e-mail my sample to you.

Here it is..

"IMCEAEX-_O=MELLON_OU=EUROPE_CN=RECIPIENTS_CN=ADCCG19"@mellon.com

good luck with that1

Here is my e-mail address

LAPillay@excite.com ....Thanks :-)

Here is my e-mail address

LAPillay@excite.com ....Thanks :-)

Here is my e-mail address

LAPillay@excite.com ....Thanks :-)

Here is my e-mail address

LAPillay@excite.com ....Thanks :-)

I don't have anything yet....

If you have already sent, is the DB zipped? It may not get through our firewall if its too big.

Simon

Simon

We're having problems with our network again... I'll e-mail it as soon as everything is OK to. I'll post a message to this forum once I've e-mailed it to you. The size of the file is 108KB.

Wicked - btw - send it to both address for speediest response...!

Thanks

Simon

Hi Simon

I've just e-mailed the db to that killer e-mail address of yours.

I'm also going to e-mail it to your home one.

inimeg

I think I have it! (but I have said that before!)

It's all to do with the holiday table as i suspected. Delete all of the records, then change the format to "dd/mm/yyyy". Also remove your input mask. Now re-enter the records and rerun the code. Success?!?

I will also email this to you.

Simon

Brilliant ... ! I get the correct answer 21hrs :-)

But... let me throw a spanner in the works :-(  Try entering this data

StartDate: 15 March 2000 14h30
EndDate:   17 March 2000 09h30
The correct answer  = 11hrs
The program gets 12hrs.

What answer do you get with the sample db I sent?

I'm testing all possible scenarios.

Rgds,
inimeg

Brilliant ... ! I get the correct answer 21hrs :-)

But... let me throw a spanner in the works :-(  Try entering this data

StartDate: 15 March 2000 14h30
EndDate:   17 March 2000 09h30
The correct answer  = 11hrs
The program gets 12hrs.

What answer do you get with the sample db I sent?

I'm testing all possible scenarios.

Rgds,
inimeg

Okay mate..

This is a new version! What was the problem? Well datediff rounds up! My bad..this version only works in minutes (then calculates the hours), so it should be quicker etc etc - let me know!

Public Function myBookedHours(StartTime As String, StartDate As String, EndTime As String, EndDate As String) As String

'   constants that indicate the working day
       
    Const WORKING_DAY_START = "08:00"
    Const WORKING_DAY_END = "16:00"
           
'   misc temp variables
       
    Dim intMinutes As Integer
    Dim intHours As Integer
    Dim intDays As Integer
       
    Dim HOURS_IN_DAY As Integer
    Dim MINUTES_IN_DAY As Integer
       
    Dim booInd As Boolean
    Dim intCount As Integer
    Dim intResult As Integer
    Dim snpCheck As Recordset
       
    intMinutes = 0
    intHours = 0
    intDays = 0
           
    HOURS_IN_DAY = DateDiff("h", WORKING_DAY_START, WORKING_DAY_END)
    MINUTES_IN_DAY = DateDiff("n", WORKING_DAY_START, WORKING_DAY_END)
       
           
'   work out the number of days excluding weekends
       
    For intCount = 0 To DateDiff("d", StartDate, EndDate) - 1
           
        intResult = WeekDay(DateAdd("d", intCount, StartDate))
        If intResult <> vbSunday And intResult <> vbSaturday Then
           Set snpCheck = CurrentDb().OpenRecordset("Select * From BankHoliday WHere HolidayDate = #" & Format(DateAdd("d", intCount + 1, StartDate), "dd/mm/yyyy") & "#", dbOpenSnapshot)
           If snpCheck.RecordCount = 0 Then
              intDays = intDays + 1
          End If
          snpCheck.Close
        End If
           
    Next
       
    intDays = intDays - 1
       
'   work out the number of hours, bearing in mind we alreayd have the number of days
       
    If StartDate <> EndDate Then    '   we spread over days

'   workout minutes on first day
           
        intMinutes = intMinutes + DateDiff("n", StartTime, WORKING_DAY_END) 'Mod 60
           
'   workout minutes on last day
           
        intMinutes = intMinutes + DateDiff("n", WORKING_DAY_START, EndTime) 'Mod 60
           
    '   any days in between?
           
        If intDays >= 1 Then
           
            intMinutes = intMinutes + ((intDays) * MINUTES_IN_DAY)
           
        End If
           
    Else    '   we are on the same day
        intMinutes = DateDiff("n", StartTime, EndTime) 'Mod 60
    End If
       
    intHours = intHours + (intMinutes / 60)
    intMinutes = intMinutes Mod 60
       
    myBookedHours = CStr(intHours) & " hours, " & CStr(intMinutes) & " minutes"
    MsgBox "Hours: " & myBookedHours
   
End Function

Simon

Hi Simon :-)

This is excellent thanks. It works perfectly!!

Your code satisfies my requirements 100%. Thanks for your hard work.

I will award the points to you ... just one last problem.

What if during the work day, 08h00 - 16h00, there is a lunch of 30 minutes?
Would it be better just to subtract the 30 minutes from my final answer HrsBooked. Is there an easier option?

Thanks again,
inimeg

Wait ....

Try this sample data

StartDate = 15 March 2000 09h23
EndDate = 15 March 2000 14h01
Correct Answer = 4hrs 38 min

Program gets 5hrs 38 min

Text from my email to ya...

inimeg,

Guess what? The site appears to be down again, so, I thought I would let you know the good news (it went down as I was sending a comment)
Change the last lines of the function to
       
    intHours = intHours + Int((intMinutes / 60))      '      <<<< THIS IS THE AMMENDED LINE
    intMinutes = intMinutes Mod 60
       
    myBookedHours = CStr(intHours) & " hours, " & CStr(intMinutes) & " minutes"
    MsgBox "Hours: " & myBookedHours
   
End Function

We need to use INT() here to make access round down, in your last example the result (i.e. total minutes / 60) was 278 minutes, or 4.63 hours. This wass rounded up to 5 and then the modulus was added. So using int ensures rounding down and removes the 'doubling up' of the modulus.

Let me know how it goes.

Simon

BTW - as for lunch, it may not be as easy as it seems. We need to take into account when lunch is - e.g. if the problem is 08:00 to 12:00 do we remove the half hour? Also, if we span multiple days we will need to remove the lunch period for each day, which simply means:

intMinutes = intMinutes - (30 * intDays)

Let me have a think....

Simon .... you're a star :-)

Everything works 100%.
Thanks for your time and hard work.

I really appreciate it.

Have a good day.

Regards,
inimeg

Thanks mate - and you too...