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

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.

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.

just messing around:

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

VB Code:

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

DDouglas
Welcome to the forums :wave:

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.

VB Code:

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

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

VB Code:

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