435,056 Members | 1,320 Online + Ask a Question
Need help? Post your question and get tips & solutions from a community of 435,056 IT Pros & Developers. It's quick & easy.

Specific Date and Time calculation

 P: 17 I am trying to calculate the amount of time spent on an issue if the work week is Monday thru Friday with a time frame of 6 AM to 10 PM only and Saturdays with a time frame of 8 AM to 6 PM. No Sundays. Following is the scenario: I open a ticket on Monday morning at 9:45 AM but do not close it out until Wednesday at 2:50 PM. I can only include the time frame of 6 am to 10 pm for all three days. Looking for an answer of 37 HRs and 05 minutes. Is there an easy way to do this? Additional info, I am running access 2010 and my knowledge of SQL is limited at best. My current DB has a start and end date in a general format to include the time. I already have an event function that eliminates the weekends which I need to adjust now for Saturdays being included. My db was completed when I was told I needed to include this calculation. May 24 '17 #1

✓ answered by PhilOfWalton

Totally different approach to jforbes using a table with start & end time. Code isn't too horrendous

Expand|Select|Wrap|Line Numbers
1. Option Compare Database
2. Option Explicit
3.
4. Private Sub Calculate_Click()
5.
6.     Dim DaysDiff As Integer
7.     Dim HrsDiff As Integer
8.     Dim SumMins As Long
9.     Dim FirstFullDate As Date
10.     Dim LastFullDate As Date
11.     Dim DayStart As Date
12.     Dim DayEnd As Date
13.     Dim DayMins As Integer
14.
15.     If IsNull(StartDate) Or Not IsDate(StartDate) Then
16.         MsgBox "Invalid Start Date"
17.         Exit Sub
18.     End If
19.
20.     If IsNull(EndDate) Or Not IsDate(EndDate) Then
21.         MsgBox "Invalid End Date"
22.         Exit Sub
23.     End If
24.
25.     If StartDate > EndDate Then
26.         MsgBox "Invalid Dates not in order"
27.         Exit Sub
28.     End If
29.
30.     DaysDiff = DateDiff("d", StartDate, EndDate)
31.
32.     If DaysDiff = 0 Then        ' Same day
33.         SumMins = SumMins + DateDiff("n", StartDate, EndDate)
34.         HrsDiff = SumMins \ 60
35.         GoTo DisplayResults
36.     End If
37.
38.     ' First Day (Subtract minutes before the hour)
39.     SumMins = SumMins + (Hour(TimeValue(DLookup("DayEnd", "TblDays", "DayID = " & Weekday(StartDate)))) - Hour(TimeValue(StartDate))) * 60
40.     SumMins = SumMins + Minute(TimeValue(DLookup("DayEnd", "TblDays", "DayID = " & Weekday(StartDate)))) - Minute(TimeValue(StartDate))
41.
42.     ' Last day (Add minutes after the hour)
43.     SumMins = SumMins + (Hour(TimeValue(DLookup("DayEnd", "TblDays", "DayID = " & Weekday(EndDate)))) - Hour(TimeValue(EndDate))) * 60
44.     SumMins = SumMins + Minute(TimeValue(DLookup("DayEnd", "TblDays", "DayID = " & Weekday(EndDate)))) + Minute(TimeValue(EndDate))
45.
46.     ' Full days between Start Date & End Date
47.
48.     FirstFullDate = DateAdd("d", 1, StartDate)              ' First Full Date
49.     LastFullDate = DateAdd("d", -1, EndDate)                ' First Full Date
50.     If Day(EndDate) - Day(FirstFullDate) > 0 Then      ' Full days
51.         Do Until DaysDiff = 0
52.             DayStart = DLookup("DayStart", "TblDays", "DayID = " & Weekday(FirstFullDate))     ' Start of day
53.             DayEnd = DLookup("DayEnd", "TblDays", "DayID = " & Weekday(FirstFullDate))         ' End of day
54.             FirstFullDate = DateAdd("d", 1, FirstFullDate)           ' Next date
55.             SumMins = SumMins + DateDiff("n", TimeValue(DLookup("DayStart", "TblDays", "DayID = " & Weekday(FirstFullDate))), _
56.                 TimeValue(DLookup("DayEnd", "TblDays", "DayID = " & Weekday(FirstFullDate))))
57.             DaysDiff = Day(EndDate) - Day(FirstFullDate)
58.         Loop
59.     End If
60.
61.     ' Display the results
62. DisplayResults:
63.     HrsDiff = SumMins \ 60
64.     SumMins = SumMins - HrsDiff * 60
65.     TotalTime = HrsDiff & ":" & Format(SumMins, "00")
66.
67. End Sub
68.
So basically calculate time for the first & last day in minutes, then add ant intervening whole days.

This has the advantage of being able to change hours available each day without them being hard coded.

Hope this helps

Phil

22 Replies

 Expert Mod 15k+ P: 31,494 Well, that's nice. Just this small additional feature that'll fry your brain working it out. Lovely. It's possible to do in SQL but I wouldn't bother. It would be even more complex than doing it in VBA, and that won't be fun. Work on the basis that you have a start time and and end time. Start by calculating how many whole weeks fall between the two. Next how many whole days and, while you're about it, determine what day of the week each is. Next determine how many hours left till the end of the start day, then how many hours of the end day till the end time. All great fun. Add up all the contributing values to produce the value required. May 25 '17 #2

 Expert 100+ P: 1,107 This is my take on it: Expand|Select|Wrap|Line Numbers Public Function calcWorkMinutes(ByRef dStart As Date, ByRef dEnd As Date) As Long       Dim dDay As Date     Dim lMinutes As Long     Dim lStartTime As Long     Dim lEnddTime As Long       dDay = dStart       While dDay < dEnd         Select Case DatePart("d", dDay) Mod 7             Case 0                 ' Sunday             Case 1, 2, 3, 4, 5                 ' Monday through Friday                 If dDay = dStart Then                     ' Partial day on Start Date                     lStartTime = ((dStart - Int(dStart)) * (24 * 60))                     If lStartTime > (6 * 60) And lStartTime < (22 * 60) Then                         lMinutes = lMinutes + (10 * 60) - lStartTime                     End If                 ElseIf Int(dDay) = Int(dEnd) Then                     'Still needed                 Else                     ' Full Day                     lMinutes = lMinutes + (10 * 60)                 End If             Case 6                 ' Saturday         End Select         dDay = dDay + 1     Wend       calcWorkMinutes = lMinutes End Function It's incomplete, but should give you the idea. May 25 '17 #3

 Expert 100+ P: 1,430 Totally different approach to jforbes using a table with start & end time. Code isn't too horrendous Expand|Select|Wrap|Line Numbers Option Compare Database Option Explicit   Private Sub Calculate_Click()       Dim DaysDiff As Integer     Dim HrsDiff As Integer     Dim SumMins As Long     Dim FirstFullDate As Date     Dim LastFullDate As Date     Dim DayStart As Date     Dim DayEnd As Date     Dim DayMins As Integer       If IsNull(StartDate) Or Not IsDate(StartDate) Then         MsgBox "Invalid Start Date"         Exit Sub     End If       If IsNull(EndDate) Or Not IsDate(EndDate) Then         MsgBox "Invalid End Date"         Exit Sub     End If       If StartDate > EndDate Then         MsgBox "Invalid Dates not in order"         Exit Sub     End If       DaysDiff = DateDiff("d", StartDate, EndDate)       If DaysDiff = 0 Then        ' Same day         SumMins = SumMins + DateDiff("n", StartDate, EndDate)         HrsDiff = SumMins \ 60         GoTo DisplayResults     End If       ' First Day (Subtract minutes before the hour)     SumMins = SumMins + (Hour(TimeValue(DLookup("DayEnd", "TblDays", "DayID = " & Weekday(StartDate)))) - Hour(TimeValue(StartDate))) * 60     SumMins = SumMins + Minute(TimeValue(DLookup("DayEnd", "TblDays", "DayID = " & Weekday(StartDate)))) - Minute(TimeValue(StartDate))       ' Last day (Add minutes after the hour)     SumMins = SumMins + (Hour(TimeValue(DLookup("DayEnd", "TblDays", "DayID = " & Weekday(EndDate)))) - Hour(TimeValue(EndDate))) * 60     SumMins = SumMins + Minute(TimeValue(DLookup("DayEnd", "TblDays", "DayID = " & Weekday(EndDate)))) + Minute(TimeValue(EndDate))       ' Full days between Start Date & End Date       FirstFullDate = DateAdd("d", 1, StartDate)              ' First Full Date     LastFullDate = DateAdd("d", -1, EndDate)                ' First Full Date     If Day(EndDate) - Day(FirstFullDate) > 0 Then      ' Full days         Do Until DaysDiff = 0             DayStart = DLookup("DayStart", "TblDays", "DayID = " & Weekday(FirstFullDate))     ' Start of day             DayEnd = DLookup("DayEnd", "TblDays", "DayID = " & Weekday(FirstFullDate))         ' End of day             FirstFullDate = DateAdd("d", 1, FirstFullDate)           ' Next date             SumMins = SumMins + DateDiff("n", TimeValue(DLookup("DayStart", "TblDays", "DayID = " & Weekday(FirstFullDate))), _                 TimeValue(DLookup("DayEnd", "TblDays", "DayID = " & Weekday(FirstFullDate))))             DaysDiff = Day(EndDate) - Day(FirstFullDate)         Loop     End If       ' Display the results DisplayResults:     HrsDiff = SumMins \ 60     SumMins = SumMins - HrsDiff * 60     TotalTime = HrsDiff & ":" & Format(SumMins, "00")   End Sub   So basically calculate time for the first & last day in minutes, then add ant intervening whole days. This has the advantage of being able to change hours available each day without them being hard coded. Hope this helps Phil May 25 '17 #4

 P: 17 Thank you so much for your help, I will give it a try and see what happens. May 25 '17 #5

 P: 17 Phil, I got two good answers yours and Jforbes, I am going to try them both to see which one will work the best for me in what I am trying to do. I really appreciate your help on this. May 25 '17 #6

 P: 17 Phil, I have input the code you showed above and have tried to run it. Every time I do I get an error message "Run-Time error "6": Overflow" starting with the following code: 'Full days between Start Date & End Date FirstFullDate = DateAdd("d", 1, StartDate) 'First Full Date I have been trying to figure out what I am missing, but I am not having any luck. Can you help or at least point me in the right direction so that I can figure this out. This is the last piece of my database that I need so I can put it into production. I really Appreciate your help, Dave May 31 '17 #7

 Expert 100+ P: 1,430 Hi Dave, We need to find out precisely where the error occurs. Do this by putting a break point on the line "If IsNull(StartDate) Or Not IsDate(StartDate) Then" Then step through to see where the overflow occurs. Depending on your dates, you may need to define HrsDiff as Long rather than integer. What dates are you using that gives the error? Phil May 31 '17 #8

 P: 17 Phil, First off thank you for your help, secondly I tried stepping through with the break point and the only thing I still see is that it flags the same line I stated before. I then changed the HrsDiff as Long and the same thing happened. The dates I am trying to run are SD 05/23/2017 9:45 AM ED: 05/25/2017 2:45 PM. I even tried changing the date structure to DD/MM/YYYY and still the same result. WHat I did do was create a new table called TblDays to store the data that is entered from the form. Could this be the issue. I named the fields in this table as StartDate, EndDate and TotalTime. May 31 '17 #9

 Expert 100+ P: 1,430 Very odd, Dave. I am using English dates DD/MM/YYYY HH:MM:SS Those dates work with no problem giving 36:40 Is your table of days identical to mine (with I hope the correct spelling of Saturday) What happens if in the Immediate Window you type ? DateAd("d",1, #05/23/2017 9:45 AM#) Phil May 31 '17 #10

P: 17
Phil, I am attaching an excel file that shows the two tables and the form I created. I have also included the code you gave me am I missing something that I do not see? I know sometimes I can be pretty blind. Dave
Attached Files Time and Date.xlsx (93.1 KB, 154 views)
May 31 '17 #11

 Expert 100+ P: 1,430 Hi Dave You appear to have changed the Dim statements from Long to Integer. That is probably where you are getting an overflow. What happened with What happens if in the Immediate Window you type ? DateAd("d",1, #05/23/2017 9:45 AM#) Phil May 31 '17 #12

 P: 17 OK so I really am an idiot, I went back and made sure all of the DIMS are exactly like how you have them originally listed, I now get all the way through up until the last line of the code which is "TotalTime = HrsDiff & ":" & Format (SumMins, "00")How should my field total time be setup as a number, text, or calculation? I also went back and changed the HrsDiff to Long. May 31 '17 #13

 P: 17 SO, I actually changed the TotalTime field to a text field and it now works, gosh I feel so stupid. I now have a working model so I can complete my original DB thank you so very much I can't tell you how much this helps me out. May 31 '17 #14

 Expert 100+ P: 1,430 Great Good luck with the rest of tour project. Incidentally, if you need to do any calculations with your TotalTime field , you can use CDate(TotalTime) Phil May 31 '17 #15

 P: 17 Thanks again Phil for be so patient with me and helping me through this. May 31 '17 #16

 P: 17 Phil, Are you out there? I am having an issue with the code above and not sure why. If I add an additional hour to the example above and make the end date 5/24/17 15:50 PM instead of adding an hour to 38.05 it subtracts and hour and makes it 36.05. What do I need to change? Jun 20 '17 #17

 Expert 100+ P: 1,430 Sorry, the result in the original picture was wrong. I think the answer should gave been 35:25, not 37:05 So you need to change 4 lines of code - it's obvious which ones Expand|Select|Wrap|Line Numbers     ' First Day (Subtract minutes before the hour)     SumMins = SumMins + (Hour(TimeValue(DLookup("DayEnd", "TblDays", "DayID = " & Weekday(StartDate)))) - Hour(TimeValue(StartDate))) * 60     SumMins = SumMins + Minute(TimeValue(DLookup("DayEnd", "TblDays", "DayID = " & Weekday(StartDate)))) - Minute(TimeValue(StartDate))       ' Last day (Add minutes after the hour)     SumMins = SumMins + (Hour(TimeValue(EndDate)) - 1 - Hour(TimeValue(DLookup("DayStart", "TblDays", "DayID = " & Weekday(EndDate))))) * 60     SumMins = SumMins + 60 - (Minute(TimeValue(DLookup("DayStart", "TblDays", "DayID = " & Weekday(EndDate)))) + Minute(TimeValue(EndDate)))   See if that works Phil Jun 20 '17 #18

P: 17
Phil, I tried the code but I am still getting the same result it's almost like it should be reverse Like if I change the end time from the original 2:50 to 1:50 it should calculate down from 37.05 to 36. 05 and yet it calculates it up going to 38.05. When I change the time form 2:50 to 3:50 it should calculate to 38.05 and instead it calculates to 36:05 so instead of adding it is subtracting. I am including a file that has the latest code that I have.
Attached Files Latest Code.xlsx (10.0 KB, 137 views)
Jun 20 '17 #19

 Expert 100+ P: 1,430 Very odd Assuming the table is as my very early posting and with Start Date 22/05/2017 09:45:00 End Date 24/05/2017 14:50:00 I get 35:25 With Start Date 22/05/2017 09:45:00 End Date 24/05/2017 15:50:00 I get 36:25 Are we agreed that those are the correct times, not the 36:05 and 37:05? Phil Jun 20 '17 #20

 P: 17 Phil I manual figured out the difference for the 22/05/2017 09:45:00 and the end date of 24/05/2017 14:50. Based on the table where Monday thru Friday is 6:00 am to 22:00 pm it does come out to 37.05. If you add 1 hour to the end date and make it 15:50 pm when you calc it should show 38.05 because you are adding an hour instead, it shows 36.05 which is actually an hour less. I went back and re loaded your original program which is the same as I had and I still get the same result. Is there a way to trick it to think that when the end time is increased it actually adds an hour to the end time versus taking it away? This would have to apply to the Start Date as well. Your thoughts Jun 21 '17 #21

 Expert 100+ P: 1,430 Must be going senile The calculation for the First day and the whole days is correct. It is as you suspected the last day calculation that was wrong. I was just being stupid Try Expand|Select|Wrap|Line Numbers  ' Last day (Add minutes after the hour)     SumMins = SumMins + (Hour(TimeValue(EndDate)) - Hour(TimeValue(DLookup("DayStart", "TblDays", "DayID = " & Weekday(EndDate))))) * 60     SumMins = SumMins + Minute(TimeValue(EndDate)) - (Minute(TimeValue(DLookup("DayStart", "TblDays", "DayID = " & Weekday(EndDate)))))   Basically all the right words, but not neccessarily in the right order!! Phil Jun 21 '17 #22

 P: 17 Phil, this is now working as expected, thank you again so much for your help. Dave Jun 21 '17 #23 