A more complete datediff function

One of the more common questions I receive in my Access classes is how to display the difference between two dates. VBA has always had the datediff function; however, this function only allows you to display the difference with one date part (year, month, or day – not all three together). So, instead of seeing the difference as 1 year 2 months and 3 days, you can choose one date part.

I highly recommend reading newsgroups for valuable information about programming (use msnews.microsoft.com if you don’t have a news server available). Microsoft MVPs (most valuable professionals) constantly post and answer questions in these groups. Douglas Steele is one of the MVPs which posts quite often and has some very useful code samples on his website.

One of the functions, posted here, lets you calculate a "precise" difference between two date/time values.

You specify how you want the difference between two date/times to be calculated by providing which of ymdhns (for years, months, days, hours, minutes and seconds) you want calculated.

For example:

?Diff2Dates("y", #06/01/1998#, #06/26/2002#)
4 years
?Diff2Dates("ymd", #06/01/1998#, #06/26/2002#)
4 years 25 days
?Diff2Dates("ymd", #06/01/1998#, #06/26/2002#, True)
4 years 0 months 25 days
?Diff2Dates("d", #06/01/1998#, #06/26/2002#)
1486 days

?Diff2Dates("h", #01/25/2002 01:23:01#, #01/26/2002 20:10:34#)
42 hours
?Diff2Dates("hns", #01/25/2002 01:23:01#, #01/26/2002 20:10:34#)
42 hours 47 minutes 33 seconds
?Diff2Dates("dhns", #01/25/2002 01:23:01#, #01/26/2002 20:10:34#)
1 day 18 hours 47 minutes 33 seconds

?Diff2Dates("ymd",#12/31/1999#,#1/1/2000#)
1 day
?Diff2Dates("ymd",#1/1/2000#,#12/31/1999#)
-1 day
?Diff2Dates("ymd",#1/1/2000#,#1/2/2000#)
1 day

'***************** Code Start **************
Public Function Diff2Dates(Interval As String, Date1 As Date, Date2 As Date, _
Optional ShowZero As Boolean = False) As Variant
'Author: © Copyright 2001 Pacific Database Pty Limited
' Graham R Seach MCP MVP gseach@pacificdb.com.au
' Phone: +61 2 9872 9594 Fax: +61 2 9872 9593
' This code is freeware. Enjoy...
' (*) Amendments suggested by Douglas J. Steele MVP
'
'Description: This function calculates the number of years,
' months, days, hours, minutes and seconds between
' two dates, as elapsed time.
'
'Inputs: Interval: Intervals to be displayed (a string)
' Date1: The lower date (see below)
' Date2: The higher date (see below)
' ShowZero: Boolean to select showing zero elements
'
'Outputs: On error: Null
' On no error: Variant containing the number of years,
' months, days, hours, minutes & seconds between
' the two dates, depending on the display interval
' selected.
' If Date1 is greater than Date2, the result will
' be a negative value.
' The function compensates for the lack of any intervals
' not listed. For example, if Interval lists "m", but
' not "y", the function adds the value of the year
' component to the month component.
' If ShowZero is True, and an output element is zero, it
' is displayed. However, if ShowZero is False or
' omitted, no zero-value elements are displayed.
' For example, with ShowZero = False, Interval = "ym",
' elements = 0 & 1 respectively, the output string
' will be "1 month" - not "0 years 1 month".

On Error GoTo Err_Diff2Dates

Dim booCalcYears As Boolean
Dim booCalcMonths As Boolean
Dim booCalcDays As Boolean
Dim booCalcHours As Boolean
Dim booCalcMinutes As Boolean
Dim booCalcSeconds As Boolean
Dim booSwapped As Boolean
Dim dtTemp As Date
Dim intCounter As Integer
Dim lngDiffYears As Long
Dim lngDiffMonths As Long
Dim lngDiffDays As Long
Dim lngDiffHours As Long
Dim lngDiffMinutes As Long
Dim lngDiffSeconds As Long
Dim varTemp As Variant

Const INTERVALS As String = "dmyhns"

'Check that Interval contains only valid characters
Interval = LCase$(Interval)
For intCounter = 1 To Len(Interval)
If InStr(1, INTERVALS, Mid$(Interval, intCounter, 1)) = 0 Then
Exit Function
End If
Next intCounter

'Check that valid dates have been entered
If Not (IsDate(Date1)) Then Exit Function
If Not (IsDate(Date2)) Then Exit Function

'If necessary, swap the dates, to ensure that
'Date1 is lower than Date2
If Date1 > Date2 Then
dtTemp = Date1
Date1 = Date2
Date2 = dtTemp
booSwapped = True
End If

Diff2Dates = Null
varTemp = Null

'What intervals are supplied
booCalcYears = (InStr(1, Interval, "y") > 0)
booCalcMonths = (InStr(1, Interval, "m") > 0)
booCalcDays = (InStr(1, Interval, "d") > 0)
booCalcHours = (InStr(1, Interval, "h") > 0)
booCalcMinutes = (InStr(1, Interval, "n") > 0)
booCalcSeconds = (InStr(1, Interval, "s") > 0)

'Get the cumulative differences
If booCalcYears Then
lngDiffYears = Abs(DateDiff("yyyy", Date1, Date2)) - _
IIf(Format$(Date1, "mmddhhnnss") <= Format$(Date2, "mmddhhnnss"), 0, 1)
Date1 = DateAdd("yyyy", lngDiffYears, Date1)
End If

If booCalcMonths Then
lngDiffMonths = Abs(DateDiff("m", Date1, Date2)) - _
IIf(Format$(Date1, "ddhhnnss") <= Format$(Date2, "ddhhnnss"), 0, 1)
Date1 = DateAdd("m", lngDiffMonths, Date1)
End If

If booCalcDays Then
lngDiffDays = Abs(DateDiff("d", Date1, Date2)) - _
IIf(Format$(Date1, "hhnnss") <= Format$(Date2, "hhnnss"), 0, 1)
Date1 = DateAdd("d", lngDiffDays, Date1)
End If

If booCalcHours Then
lngDiffHours = Abs(DateDiff("h", Date1, Date2)) - _
IIf(Format$(Date1, "nnss") <= Format$(Date2, "nnss"), 0, 1)
Date1 = DateAdd("h", lngDiffHours, Date1)
End If

If booCalcMinutes Then
lngDiffMinutes = Abs(DateDiff("n", Date1, Date2)) - _
IIf(Format$(Date1, "ss") <= Format$(Date2, "ss"), 0, 1)
Date1 = DateAdd("n", lngDiffMinutes, Date1)
End If

If booCalcSeconds Then
lngDiffSeconds = Abs(DateDiff("s", Date1, Date2))
Date1 = DateAdd("s", lngDiffSeconds, Date1)
End If

If booCalcYears And (lngDiffYears > 0 Or ShowZero) Then
varTemp = lngDiffYears & IIf(lngDiffYears <> 1, " years", " year")
End If

If booCalcMonths And (lngDiffMonths > 0 Or ShowZero) Then
If booCalcMonths Then
varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
lngDiffMonths & IIf(lngDiffMonths <> 1, " months", " month")
End If
End If

If booCalcDays And (lngDiffDays > 0 Or ShowZero) Then
If booCalcDays Then
varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
lngDiffDays & IIf(lngDiffDays <> 1, " days", " day")
End If
End If

If booCalcHours And (lngDiffHours > 0 Or ShowZero) Then
If booCalcHours Then
varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
lngDiffHours & IIf(lngDiffHours <> 1, " hours", " hour")
End If
End If

If booCalcMinutes And (lngDiffMinutes > 0 Or ShowZero) Then
If booCalcMinutes Then
varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
lngDiffMinutes & IIf(lngDiffMinutes <> 1, " minutes", " minute")
End If
End If

If booCalcSeconds And (lngDiffSeconds > 0 Or ShowZero) Then
If booCalcSeconds Then
varTemp = varTemp & IIf(IsNull(varTemp), Null, " ") & _
lngDiffSeconds & IIf(lngDiffSeconds <> 1, " seconds", " second")
End If
End If

If booSwapped Then
varTemp = "-" & varTemp
End If

Diff2Dates = Trim$(varTemp)

End_Diff2Dates:
Exit Function

Err_Diff2Dates:
Resume End_Diff2Dates

End Function
'************** Code End *****************

Check out Doug's homepage for more great samples.