Function Age (BeginDate, EndDate) As String

Dim Answer As String
Dim Years As Integer, Months As Integer, days As Integer, AllDays As Long
Dim StoreDate1 As Variant, StoreDate2 As Variant

On Error Resume Next


' Calculate the number of years
Years = DateDiff("yyyy", BeginDate, EndDate)


' Calculate the number of months, then subtract from that the
' number of months in all previous years.  Result is number of months
' since the end-boundary of the last whole-year.
Months = DateDiff("m", BeginDate, EndDate)

    If Months < Years * 12 Then Years = Years - 1

Months = Months - (Years * 12)


' Calculate the number of days, then subtract from that the number
' of days in all previous whole-years.  AllDays is the number of days
' since the end-boundary of the last whole-year.
AllDays = DateDiff("d", BeginDate, EndDate) - (Years * 365.25)


' Calculate the date of the end-boundary of the last whole-year.
StoreDate1 = DateAdd("d", (AllDays * -1), EndDate)


' Add to it the number of whole months between StoreDate1 and EndDate.
StoreDate2 = DateAdd("m", Months, StoreDate1)


' Calculate number of days between last whole-month end-boundary and EndDate.
days = DateDiff("d", StoreDate2, EndDate)


' If number of days is negative (because DateDiff records a change in the month
' rather than count a specific number of days), subtract 1 from the month value
' and re-calculate StoreDate2, so that number of days can be re-calculated correctly.
    If days < 0 Then
        Months = Months - 1
        StoreDate2 = DateAdd("m", Months, StoreDate1)
        days = DateDiff("d", StoreDate2, EndDate)
    End If


' Restore the Months field to its previous value
' if the previous if-then block was true
    If Months < 0 Then Months = 0

If (Month(BeginDate) = Month(EndDate)) And (Day(BeginDate) > Day(EndDate)) Then
     Years = Years - 1
     Months = 11
End If


' Build the Answer string.
Answer = Years & " Year(s), " & Months & " Month(s), " & days & " Day(s)."
Age = Answer

End Function
