Visual Basic for Applications/Time Lapsed Between Dates

Summary

This module contains VBA code to calculate the lapsed time between two fully expressed dates; that is, containing both date and time information. It can run in any MS Office applications like Excel that can run VBA code.

This procedure shows how to extract integer values of the time components from a date variable rather than the more usual string representation of a date. That is to say, assuming that the difference between two dates is two days, to extract the integer two instead of some date string for the year 1900.
Date variables contain a combination of both dates and times, but they need not do so. Some have only dates and some have only times, and when converted to the single data type, they can be seen to represent days in their integer parts and times in their fractions. Although the input parameters can contain any date variables, exact results are obtained only when both times and dates are included in each parameter. If time data is missing from a date, the calculation is still performed but uses midnight as the assumption.
The integer part of a date-converted-to-single is just the number of days since 31 Dec 1899 . It follows then that negative integer parts describe the days before that reference date. In fact the date function can be used for dates in the Gregorian calendar from Aug 2, 718 through Dec 31, 9999, though this differs when other calendars are in use. Add integers to, or subtract integers from date variables to modify the date by that number of days. Subtraction also applies.
The fractional part of a date represents a part of a day. The individual parts of time within it can be obtained as follows; multiply the date variable by 86400 to find the whole-seconds; by 1440 for whole-minutes; and by 24 for whole-hours. Then convert these results to the single data type before taking each integer part. To modify an existing date variable by a number of seconds, we simply add 1/86400 to it for each second; 1/1440 per minute, 1/24 per hour, and as stated earlier, whole units for days. Subtraction also applies.
Various functions also exist to simplify date-time handling.

The Code Module

Copy all of the VBA code below into a standard module.

Run the top procedure to test the function. Two examples are given; one for exact date-time data and another where some time data is missing.
The output result is a colon-separated string, containing any of a selection of formats; seconds only, minutes-seconds, hours-minutes-seconds, or days-hours-minutes-seconds. The format option is set with sConfig, and the optional units label is returned in sLabel.
The procedure's detail is useful. The procedure LapsedTime() illustrates the basics of multi-component extraction, as compared to the use of the VBA DateDiff function's counting intervals of one type.

Option Explicit

Sub testLapsedTime()
    'Run this to test LapsedTime()
    'For both fully expressed and
    'partially expressed date-times
    
    Dim dDateTimeStart As Date
    Dim dDateTimeEnd As Date
    Dim sOut As String, sLab As String

'EXACT LAPSED TIME FOR TWO DATE-TIME VALUES
    
    'set two exact date-times for calculation
    dDateTimeStart = #1/5/2019 1:20:10 PM# '
    dDateTimeEnd = #1/7/2019 2:37:20 PM#
    
    'exactly 2 days, 1 hours, 17 mins, and 10 seconds apart
    sOut = LapsedTime(dDateTimeEnd, dDateTimeStart, "dhms", sLab)
    MsgBox "Exact Lapsed Time:" & vbCrLf & "For fully expressed date-times:" & vbCrLf & vbCrLf & _
    Format(dDateTimeEnd, "mmm dd yyyy" & ", hh:mm:ss") & " End Time" & vbCrLf & _
    Format(dDateTimeStart, "mmm dd yyyy" & ", hh:mm:ss") & " Start Time" & vbCrLf & vbCrLf & _
    sOut & " , " & sLab

'WITH SOME TIME INFO MISSING - DEFAULTS TO MIDNIGHT
    
    'set the incomplete date-times for calculation
    'first item has no time data so DEFAULTS TO MIDNIGHT
    dDateTimeStart = #1/5/2019# 'assumes time 0:0:0
    dDateTimeEnd = #1/7/2019 2:37:20 PM#
    
    'default time given as 2 days, 14 hours, 37 mins, and 20 seconds apart
    sOut = LapsedTime(dDateTimeEnd, dDateTimeStart, "dhms", sLab)
    MsgBox "Default value of Lapsed Time:" & vbCrLf & "When time data is missing," & vbCrLf & _
    "midnight is assumed:" & vbCrLf & vbCrLf & _
    Format(dDateTimeEnd, "mmm dd yyyy" & ", hh:mm:ss") & " End Time" & vbCrLf & _
    Format(dDateTimeStart, "mmm dd yyyy") & " Start Time" & vbCrLf & "becomes " & vbCrLf & _
    Format(dDateTimeStart, "mmm dd yyyy" & ", hh:mm:ss") & " Start Time" & vbCrLf & vbCrLf & _
    sOut & " , " & sLab

End Sub

Function LapsedTime(dTimeEnd As Date, dTimeStart As Date, _
      sConfig As String, Optional sLegend As String) As String
    'Returns difference of two dates (date-times) in function name.
    'Choice of various colon-separated outputs with sConfig.
    'and Optional format label found in string sLegend
    
    Dim sOut As String
    Dim dDiff As Date
        
    'Parameter Options for sConfig
    ' "s"    output in seconds. Integer.
    ' "ms"   output in minutes and seconds. mm:ss
    ' "hms"  output in hours, minutes and seconds. hh:mm:ss
    ' "dhms" output in days, hours, minutes and seconds. integer:hh:mm:ss
    
    'test parameters
    If Not IsDate(dTimeStart) Then
        MsgBox "Invalid parameter start date - closing."
    ElseIf Not IsDate(dTimeEnd) Then
        MsgBox "Invalid parameter end date - closing."
        Exit Function
    End If
    
    'difference as date-time data
    dDiff = dTimeEnd - dTimeStart
  
    'choose required output format
    Select Case sConfig
    Case "s" 'output in seconds.
        sOut = Int(CSng(dDiff * 24 * 3600))
        sLegend = "secs"
    Case "ms" 'output in minutes and seconds
        sOut = Int(CSng(dDiff * 24 * 60)) & ":" & Format(dDiff, "ss")
        sLegend = "mins:secs"
    Case "hms" 'output in hours, minutes and seconds
        sOut = Int(CSng(dDiff * 24)) & ":" & Format(dDiff, "nn:ss")
        sLegend = "hrs:mins:secs"
    Case "dhms" 'output in days, hours, minutes and seconds
        sOut = Int(CSng(dDiff)) & ":" & Format(dDiff, "hh") _
            & ":" & Format(dDiff, "nn") & ":" & _
            Format(dDiff, "ss")
        sLegend = "days:hrs:mins:secs"
    Case Else
        MsgBox "Illegal format option - closing"
        Exit Function
    End Select
    
    LapsedTime = sOut

End Function

Summary

The Code Module

See Also