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(StartDat e) Or Not IsDate(StartDat e) 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