By using this site, you agree to our updated Privacy Policy and our Terms of Use. Manage your Cookies Settings.
435,056 Members | 1,320 Online
Bytes IT Community
+ 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

Share this Question
Share on Google+
22 Replies


NeoPa
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

jforbes
Expert 100+
P: 1,107
This is my take on it:
Expand|Select|Wrap|Line Numbers
  1. Public Function calcWorkMinutes(ByRef dStart As Date, ByRef dEnd As Date) As Long
  2.  
  3.     Dim dDay As Date
  4.     Dim lMinutes As Long
  5.     Dim lStartTime As Long
  6.     Dim lEnddTime As Long
  7.  
  8.     dDay = dStart
  9.  
  10.     While dDay < dEnd
  11.         Select Case DatePart("d", dDay) Mod 7
  12.             Case 0
  13.                 ' Sunday
  14.             Case 1, 2, 3, 4, 5
  15.                 ' Monday through Friday
  16.                 If dDay = dStart Then
  17.                     ' Partial day on Start Date
  18.                     lStartTime = ((dStart - Int(dStart)) * (24 * 60))
  19.                     If lStartTime > (6 * 60) And lStartTime < (22 * 60) Then
  20.                         lMinutes = lMinutes + (10 * 60) - lStartTime
  21.                     End If
  22.                 ElseIf Int(dDay) = Int(dEnd) Then
  23.                     'Still needed
  24.                 Else
  25.                     ' Full Day
  26.                     lMinutes = lMinutes + (10 * 60)
  27.                 End If
  28.             Case 6
  29.                 ' Saturday
  30.         End Select
  31.         dDay = dDay + 1
  32.     Wend
  33.  
  34.     calcWorkMinutes = lMinutes
  35. End Function
It's incomplete, but should give you the idea.
May 25 '17 #3

PhilOfWalton
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
  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
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

PhilOfWalton
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

PhilOfWalton
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
File Type: xlsx Time and Date.xlsx (93.1 KB, 154 views)
May 31 '17 #11

PhilOfWalton
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

PhilOfWalton
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

PhilOfWalton
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
  1.     ' First Day (Subtract minutes before the hour)
  2.     SumMins = SumMins + (Hour(TimeValue(DLookup("DayEnd", "TblDays", "DayID = " & Weekday(StartDate)))) - Hour(TimeValue(StartDate))) * 60
  3.     SumMins = SumMins + Minute(TimeValue(DLookup("DayEnd", "TblDays", "DayID = " & Weekday(StartDate)))) - Minute(TimeValue(StartDate))
  4.  
  5.     ' Last day (Add minutes after the hour)
  6.     SumMins = SumMins + (Hour(TimeValue(EndDate)) - 1 - Hour(TimeValue(DLookup("DayStart", "TblDays", "DayID = " & Weekday(EndDate))))) * 60
  7.     SumMins = SumMins + 60 - (Minute(TimeValue(DLookup("DayStart", "TblDays", "DayID = " & Weekday(EndDate)))) + Minute(TimeValue(EndDate)))
  8.  
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
File Type: xlsx Latest Code.xlsx (10.0 KB, 137 views)
Jun 20 '17 #19

PhilOfWalton
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

PhilOfWalton
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
  1.  ' Last day (Add minutes after the hour)
  2.     SumMins = SumMins + (Hour(TimeValue(EndDate)) - Hour(TimeValue(DLookup("DayStart", "TblDays", "DayID = " & Weekday(EndDate))))) * 60
  3.     SumMins = SumMins + Minute(TimeValue(EndDate)) - (Minute(TimeValue(DLookup("DayStart", "TblDays", "DayID = " & Weekday(EndDate)))))
  4.  
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

Post your reply

Sign in to post your reply or Sign up for a free account.