Option Explicit 
 
Function YearsMonthsDays(Date1 As Date, Date2 As Date, Optional ShowAll As _ 
    Boolean = False, Optional Grammar As Boolean = True) 
     
     ' This function returns a string "X years, Y months, Z days" showing the time
     ' between two dates.  This function may be used in any VBA or VB project
     
     ' Date1 and Date2 must either be dates, or strings that can be implicitly
     ' converted to dates.  If these arguments have time portions, the time portions
     ' are ignored. If Date1 > Date2 (after ignoring time portions), the function
     ' returns an empty string
     
     ' ShowAll indicates whether all portions of the string "X years, Y months, Z days"
     ' are included in the output.  If ShowAll = True, all portions of the string are
     ' always included.  If ShowAll = False, then if the year portion is zero the year
     ' part of the string is omitted, and if the year portion and month portion are both
     ' zero, than both year and month portions are omitted.  The day portion is always
     ' included, and if at least one year has passed then the month portion is always
     ' included
     
     ' Grammar indicates whether to test years/months/days for singular or plural
     
     ' By definition, a "full month" means that the day number in Date2 is >= the day
     ' number in Date1, or Date1 and Date2 occur on the last days of their respective
     ' months. A "full year" means that 12 "full months" have passed.
     
     ' In Excel, this function is an alternative to the little-known DATEDIF.  DATEDIF
     ' usually works well, but can create strange results when a date is at month end.
     ' Thus, this formula:
     
     '       =DATEDIF(A1,B1,"y") & " years, " & DATEDIF(A1,B1,"ym") & " months, " &
     '       DATEDIF(A1,B1,"md") & " days"
     
     ' will return "0 years, 1 months, -2 days" for 31-Jan-2006 and 1-Mar-2006.
     ' This function will return "0 years, 1 month, 1 day"
     
     ' Chip Pearson gives a VBA equivalent in his Age() function at
     ' http://www.cpearson.com/excel/datedif.htm
     ' Unfortunately, it gives the same result in the test case above
     
    Dim TestYear As Long, TestMonth As Long, TestDay As Long 
    Dim TargetDate As Date, Last1 As Date, Last2 As Date 
     
     ' Strip time portions
    Date1 = Int(Date1) 
    Date2 = Int(Date2) 
     
     ' Test for invalid dates
    If Date1 > Date2 Then 
        YearsMonthsDays = "" 
        Exit Function 
    End If 
     
     ' Test for whether the calendar year is the same
    If Year(Date2) > Year(Date1) Then 
         
         ' Different calendar year.
         
         ' Test to see if calendar month is the same.  If it is, we have to look at the
         ' day to see if a full year has passed
        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 
             
             ' In this case, a full year has definitely passed
        ElseIf Month(Date2) > Month(Date1) Then 
            TestYear = DateDiff("yyyy", Date1, Date2) 
             
             ' A full year has not passed
        Else 
            TestYear = DateDiff("yyyy", Date1, Date2) - 1 
        End If 
         
         ' Calendar year is the same, so a full year has not passed
    Else 
        TestYear = 0 
    End If 
     
     ' Test to see how many full months have passed, in excess of the number of full
     ' years
    TestMonth = (DateDiff("m", DateSerial(Year(Date1), Month(Date1), 1), _ 
    DateSerial(Year(Date2), Month(Date2), 1)) + IIf(Day(Date2) >= _ 
    Day(Date1), 0, -1)) Mod 12 
     
     ' See how many days have passed, in excess of the number of full months.  If the day
     ' number for Date2 is >= that for Date1, it's simple
    If Day(Date2) >= Day(Date1) Then 
        TestDay = Day(Date2) - Day(Date1) 
         
         ' If not, we have to test for end of the month
    Else 
        Last1 = DateSerial(Year(Date2), Month(Date2), 0) 
        Last2 = DateSerial(Year(Date2), Month(Date2) + 1, 0) 
        TargetDate = DateSerial(Year(Date2), Month(Date2) - 1, Day(Date1)) 
        If Last2 = Date2 Then 
            If TestMonth = 11 Then 
                TestMonth = 0 
                TestYear = TestYear + 1 
            Else 
                TestMonth = TestMonth + 1 
            End If 
        Else 
            TestDay = DateDiff("d", IIf(TargetDate > Last1, Last1, TargetDate), Date2) 
        End If 
    End If 
     
    If ShowAll Or TestYear >= 1 Then 
        YearsMonthsDays = TestYear & IIf(TestYear = 1 And Grammar, " year, ", _ 
        " years, ") & TestMonth & IIf(TestMonth = 1 And Grammar, " month, ", _ 
        " months, ") & TestDay & IIf(TestDay = 1 And Grammar, " day", " days") 
    Else 
        If TestMonth >= 1 Then 
            YearsMonthsDays = TestMonth & IIf(TestMonth = 1 And Grammar, " month, ", _ 
            " months, ") & TestDay & IIf(TestDay = 1 And Grammar, " day", " days") 
        Else 
            YearsMonthsDays = TestDay & IIf(TestDay = 1 And Grammar, " day", " days") 
        End If 
    End If 
     
End Function