Specific Date and Time calculation

[dtolemy]

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.

[NeoPa]

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.

[jforbes]

This is my take on it:

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.

[PhilOfWalton]

Totally different approach to jforbes using a table with start & end time.

Code isn't too horrendous

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

[dtolemy]

Thank you so much for your help, I will give it a try and see what happens.

[dtolemy]

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.

[dtolemy]

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

[PhilOfWalton]

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

[dtolemy]

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.

[PhilOfWalton]

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

[dtolemy]

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

[PhilOfWalton]

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

[dtolemy]

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.

[dtolemy]

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.

[PhilOfWalton]

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

[dtolemy]

Thanks again Phil for be so patient with me and helping me through this.

[dtolemy]

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?

[PhilOfWalton]

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

    ' 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

[dtolemy]

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.

[PhilOfWalton]

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

[dtolemy]

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

[PhilOfWalton]

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

 ' 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

[dtolemy]

Phil, this is now working as expected, thank you again so much for your help. Dave