' Returns the difference in full months from DateOfBirth to current date,
' optionally to another date.
' Returns by reference the difference in days.
' Returns zero if AnotherDate is earlier than DateOfBirth.
'
' Calculates correctly for:
' leap Months
' dates of 29. February
' date/time values with embedded time values
' any date/time value of data type Date
'
' DateAdd() is, when adding a count of months to dates of 31th (29th),
' used for check for month end as it correctly returns the 30th (28th)
' when the resulting month has 30 or less days.
'
' 2015-11-24. Gustav Brock, Cactus Data ApS, CPH.
'
Public Function AgeMonthsDays( _
ByVal DateOfBirth As Date, _
Optional ByVal AnotherDate As Variant, _
Optional ByRef Days As Integer) _
As Long
Dim ThisDate As Date
Dim Months As Long
If IsDateExt(AnotherDate) Then
ThisDate = CDate(AnotherDate)
Else
ThisDate = Date
End If
' Find difference in calendar Months.
Months = DateDiff("m", DateOfBirth, ThisDate)
If Months < 0 Then
Months = 0
Else
If Months > 0 Then
' Decrease by 1 if current date is earlier than birthday of current year
' using DateDiff to ignore a time portion of DateOfBirth.
If DateDiff("d", ThisDate, DateAdd("m", Months, DateOfBirth)) > 0 Then
Months = Months - 1
End If
End If
' Find difference in days.
Days = DateDiff("d", DateAdd("m", Months, DateOfBirth), ThisDate)
End If
AgeMonthsDays = Months
End Function