Need function that will return amount of time between two timestamps.

[ddouglas]

I looking for a function that I can use to enter two timestamps and return the amount of time between them (in minutes).

Parameters are:
Excel Cells will be formatted as follows (dd/mm/ccyy hh/mm/ss AM/PM)
Do not include weekends in the calculation.
Do not include the time between 5pm and 8am in the calculations.

For example the values in the two cells may be:
6/16/2006 1:46:14 PM
6/19/2006 2:01:40 PM

What it should return is 552 minutes and 6 seconds.(or 552.1)

Does anyone know of a macro that does this or the code needed to build one?

Thanks,
DD.

[Static]

u will need to write your own..

DateDiff() can calc the diff in minutes.. but to remove the times between 5-8 will take some thinking and work.

[Static]

just messing around:

this did NOT take into account if there is a weekend.. but it seemed to work ok otherwise

Dim t1 As Date
    Dim t2 As Date
    Dim t1F As Date
    Dim t2F As Date
    Dim d1_mins As Integer
    Dim d2_mins As Integer
    Dim minsbtween As Integer
    
    t1 = #6/16/2006 1:46:14 PM#
    t2 = #6/19/2006 2:01:40 PM#
    
    t1F = CDate(Format(t1, "mm/dd/yyyy") & " 5:00:00 PM")
    t2F = CDate(Format(t2, "mm/dd/yyyy") & " 8:00:00 AM")
    d1_mins = DateDiff("n", t1, t1F)
    d2_mins = DateDiff("n", t2F, t2)
    minsbtween = (DateDiff("d", t1, t2) - 1) * 540
    MsgBox d1_mins + d2_mins + minsbtween

[DKenny]

DDouglas
Welcome to the forums

In your example I think you are slightly off in you calculation
13:46:14 to 17:00:00 is 3:13:46
08:00:00 to 14:01:40 is 6:01:40

giving a total of 9:15:26 or 33326 seconds or 555 mins and 26 secs or 555.43 mins.

Here's a function that will give you that answer.

Option Explicit
 
Function DDouglasDateDiff(ByVal dDate1 As Date, ByVal dDate2 As Date) As Double
Dim dbTemp As Double
Dim lDay As Long
Dim lCounter As Long
 
    'Move dDate1 forward to 8 AM on the same day,
    'if its time portion is before 8
    If DatePart("h", dDate1) < 8 Then
        dDate1 = CDate(Left(CStr(dDate1), InStr(1, CStr(dDate1), " ") - 1) & " 08:00:00")
    End If
    
    'Move dDate1 forward to 8 AM on the next day,
    'if its time portion is after 5
    If DatePart("h", dDate1) >= 17 Then
        dDate1 = CDate(Left(CStr(dDate1 + 1), InStr(1, CStr(dDate1 + 1), " ") - 1) & " 08:00:00")
    End If
    
    'Move dDate1 forward if it is a weekend
    Do While Weekday(dDate1, vbMonday) > 5
        dDate1 = CDate(Left(CStr(dDate1 + 1), InStr(1, CStr(dDate1 + 1), " ") - 1) & " 08:00:00")
    Loop
    
    'Move dDate2 back to 5 PM on the same day,
    'if its time portion is after 5
    If DatePart("h", dDate2) >= 17 Then
        dDate1 = CDate(Left(CStr(dDate2), InStr(1, CStr(dDate2), " ") - 1) & " 17:00:00")
    End If
    
    'Move dDate2 back to 5 PM on the previous day,
    'if its time portion is before 8
    If DatePart("h", dDate2) < 8 Then
        dDate1 = CDate(Left(CStr(dDate2 - 1), InStr(1, CStr(dDate2 - 1), " ") - 1) & " 17:00:00")
    End If
    
    'Move dDate2 backward if it is a weekend
    Do While Weekday(dDate2, vbMonday) > 5
        dDate1 = CDate(Left(CStr(dDate2 - 1), InStr(1, CStr(dDate2 - 1), " ") - 1) & " 08:00:00")
    Loop
    
    'Get the number of seconds between the dates
    dbTemp = DateDiff("s", dDate1, dDate2)
    
    'Get the number of days between the dates
    lDay = DateDiff("d", dDate1, dDate2)
    
    If lDay <> 0 Then
        For lCounter = 1 To lDay
            If Weekday(dDate1 + lCounter, vbMonday) > 5 Then
                'For weekends remove 24 hours
                dbTemp = dbTemp - 86400 '(24 hrs * 60 mins * 60 secs)
            Else
                'For all other days, remove 15 hours (5PM - 8AM)
                dbTemp = dbTemp - 54000 '(15 hrs * 60 mins * 60 secs)
            End If
        Next lCounter
    End If
    
    'Convert to minutes
    DDouglasDateDiff = dbTemp / 60
    
    
End Function

[DKenny]

Here's a tidier version, using the Format function, rather than manually parsing the "date" portion

Function DDouglasDateDiff(ByVal dDate1 As Date, ByVal dDate2 As Date) As Double
Dim dbTemp As Double
Dim lDay As Long
Dim lCounter As Long
 
    'Move dDate1 forward to 8 AM on the same day,
    'if its time portion is before 8
    If DatePart("h", dDate1) < 8 Then
        dDate1 = CDate(Format(dDate1, "yyyy/mm/dd") & " 08:00:00")
    End If
    
    'Move dDate1 forward to 8 AM on the next day,
    'if its time portion is after 5
    If DatePart("h", dDate1) >= 17 Then
        dDate1 = CDate(Format(dDate1 + 1, "yyyy/mm/dd") & " 08:00:00")
    End If
    
    'Move dDate1 forward if it is a weekend
    Do While Weekday(dDate1, vbMonday) > 5
        dDate1 = CDate(Format(dDate1 + 1, "yyyy/mm/dd") & " 08:00:00")
    Loop
    
    'Move dDate2 back to 5 PM on the same day,
    'if its time portion is after 5
    If DatePart("h", dDate2) >= 17 Then
        dDate1 = CDate(Format(dDate2, "yyyy/mm/dd") & " 17:00:00")
    End If
    
    'Move dDate2 back to 5 PM on the previous day,
    'if its time portion is before 8
    If DatePart("h", dDate2) < 8 Then
        dDate1 = CDate(Format(dDate2 - 1, "yyyy/mm/dd") & " 17:00:00")
    End If
    
    'Move dDate2 backward if it is a weekend
    Do While Weekday(dDate2, vbMonday) > 5
        dDate1 = CDate(Format(dDate2 - 1, "yyyy/mm/dd") & " 08:00:00")
    Loop
    
    'Get the number of seconds between the dates
    dbTemp = DateDiff("s", dDate1, dDate2)
    
    'Get the number of days between the dates
    lDay = DateDiff("d", dDate1, dDate2)
    
    If lDay <> 0 Then
        For lCounter = 1 To lDay
            If Weekday(dDate1 + lCounter, vbMonday) > 5 Then
                'For weekends remove 24 hours
                dbTemp = dbTemp - 86400 '(24 hrs * 60 mins * 60 secs)
            Else
                'For all other days, remove 15 hours (5PM - 8AM)
                dbTemp = dbTemp - 54000 '(15 hrs * 60 mins * 60 secs)
            End If
        Next lCounter
    End If
    
    'Convert to minutes
    DDouglasDateDiff = dbTemp / 60
    
    
End Function