Code:
Option Explicit
Function YearsMonthsDays(Date1 As Date, Date2 As Date, Optional ShowAll As Boolean = True)
Dim TestYear As Long, TestMonth As Long, TestDay As Long
If Date1 > Date2 Then
YearsMonthsDays = ""
Exit Function
End If
If Year(Date2) > Year(Date1) Then
If Month(Date2) = Month(Date1) Then
If Day(Date2) >= Day(Date1) Then
TestYear = DateDiff("yyyy", Date1, Date2)
Else
TestYear = DateDiff("yyyy", Date1, Date2) - 1
End If
ElseIf Month(Date2) > Month(Date1) Then
TestYear = DateDiff("yyyy", Date1, Date2)
Else
TestYear = DateDiff("yyyy", Date1, Date2) - 1
End If
Else
TestYear = 0
End If
TestMonth = (DateDiff("m", DateSerial(Year(Date1), Month(Date1), 1), DateSerial(Year(Date2), _
Month(Date2), 1)) + IIf(Day(Date2) >= Day(Date1), 0, -1)) Mod 12
If Day(Date2) >= Day(Date1) Then
TestDay = Day(Date2) - Day(Date1)
Else
TestDay = DateDiff("d", DateSerial(Year(Date2), Month(Date2) - 1, Day(Date1)), Date2)
End If
If ShowAll Or TestYear >= 1 Then
YearsMonthsDays = TestYear & IIf(TestYear = 1, " year, ", " years, ") & TestMonth & _
IIf(TestMonth = 1, " month, ", " months, ") & TestDay & IIf(TestDay = 1, " day", " days")
Else
If TestMonth >= 1 Then
YearsMonthsDays = TestMonth & IIf(TestMonth = 1, " month, ", " months, ") & _
TestDay & IIf(TestDay = 1, " day", " days")
Else
YearsMonthsDays = TestDay & IIf(TestDay = 1, " day", " days")
End If
End If
End Function