Question : Calculate age by birthday in years, months, and days

I have followed Microsoft recommendations from http://support.microsoft.com/?kbid=210522 and it works great! However, most of the patients my clients see are infants and children they have requested that days be included in the year, month format. sSo, if an infant is seen it would appear as 0 yr 0mth 18 dys. How do I do this?

Answer : Calculate age by birthday in years, months, and days

Van,

> It seems to be almost accurate (1 day off). What do you guys think?
If it isn't accurate, what's the purpose?
These things can be serious. For employment, as an example, many rules relate to exact

counts of months and days. No exception will be granted because you claim that "my

function is just a little bit off".

> I am unable to find any errors ..
If you do a little testing you will them. Here are a few samples.

Your own AgeCalc:
? AgeCalc(#2/29/1996#,#4/30/2005#)
9 Y 2 M and 2 D.

Slimcutter AgeCalc:

? AgeCalc(#1/30/1996#,#4/30/2005#)
9 Y 3 M and 9 D.

? AgeCalc(#2/29/1996#,#4/30/2005#)
9 Y 2 M and 8 D.

Capricorn (modified to accept a today's date):

? GetAge(#1/31/1996#,#4/30/2005#)
9 Yrs 2 Mos 29 Days

My own quickie (previous post) which would fail too:

? StrAgeYMD(#1/31/1996#,#4/30/2005#)
9 years 3 months 30 days

? StrAgeYMD(#2/29/1996#,#4/30/2005#)
9 years 2 months 1 day

But below find the corrected that does the days count correctly:

? StrAgeYMD(#1/30/1996#,#4/30/2005#)
9 years 3 months 0 days

? StrAgeYMD(#1/31/1996#,#4/30/2005#)
9 years 3 months 0 days

? StrAgeYMD(#2/29/1996#,#4/30/2005#)
9 years 2 months 0 days

and a few other examples:

? StrAgeYMD(#2/29/2000#,#5/29/2004#)
4 years 2 months 29 days

? StrAgeYMD(#5/29/2000#,#2/29/2004#)
3 years 9 months 1 day

? StrAgeYMD(#2/29/2000#,#5/30/2004#)
4 years 3 months 0 days

? StrAgeYMD(#5/30/2000#,#2/29/2004#)
3 years 9 months 0 days

The tricky part is that you have to take into account the varying last day of the months and that 30 days are regarded as a full month, so is the 28/29 days of February. This can be seen from the three examples above and from the _wrong_ examples here which you would get if you didn't make this correction:

? WrongAge(#1/30/1996#,#4/30/2005#)
9 years 3 months 1 day

? WrongAge(#1/31/1996#,#4/30/2005#)
9 years 2 months 30 days

? WrongAge(#2/29/1996#,#4/30/2005#)
9 years 2 months 1 day

Corrected functions:

Public Function StrAgeYMD( _
  ByVal datDateOfBirth As Date, _
  Optional datDateOfToday As Date) _
  As String

' Calculates and formats age as years, months, and days.
' If no DateOfToday is passed, today's date is used.
' Handles both positive as well as negative ages.
'
' Uses:
'   MonthsDays()
'
' 2005-01-08. Cactus Data ApS, CPH.

  Const clngYearMonths    As Long = 12
 
  Dim lngDays             As Long
  Dim lngMonths           As Long
  Dim lngYears            As Long
  Dim strYears            As String
  Dim strMonths           As String
  Dim strDays             As String
 
  If CDbl(datDateOfToday) = 0 Then
    ' Use today's date.
    datDateOfToday = Date
  End If
 
  ' Retrieve count of months and days.
  lngMonths = MonthsDays(datDateOfBirth, datDateOfToday, lngDays)
  ' Calculate count of years and months.
  lngYears = lngMonths \ clngYearMonths
  lngMonths = lngMonths Mod clngYearMonths
 
  ' Format and return string with count of years, months, and days.
  strYears = lngYears & " year" & IIf(lngYears <> 1, "s", vbNullString)
  strMonths = lngMonths & " month" & IIf(lngMonths <> 1, "s", vbNullString)
  strDays = lngDays & " day" & IIf(lngDays <> 1, "s", vbNullString)
 
  StrAgeYMD = strYears & " " & strMonths & " " & strDays
 
End Function


Public Function MonthsDays( _
  ByVal datDate1 As Date, _
  ByVal datDate2 As Date, _
  ByRef lngDays As Long) _
  As Long

' Returns the difference in full months between datDate1 and datDate2
' and the difference in days in the parameter lngDays.
'
' Calculates correctly for:
'   negative differences
'   leap years
'   dates of 29. February
'   date/time values with embedded time values
'   negative date/time values (prior to 1899-12-29)
'
' 2005-01-08. Cactus Data ApS, CPH.

  ' Standard ultimo day of a month.
  Const cintMonthDayUltimo  As Integer = 30
 
  Dim intDay1               As Integer
  Dim intDay2               As Integer
  Dim lngMonths             As Long
  Dim lngDaysDiff           As Long
  Dim lngReversed           As Long
 
  ' No special error handling.
  On Error Resume Next
 
  ' Calculate basic month difference.
  lngMonths = DateDiff("m", datDate1, datDate2)
  intDay1 = Day(datDate1)
  intDay2 = Day(datDate2)
 
  ' Adjust ultimo dates.
  If Month(datDate1) < Month(DateAdd("d", 1, datDate1)) Then
    ' Date datDate1 is ultimo.
    intDay1 = cintMonthDayUltimo
    ' Decrease date intDate2 if day of datDate2 is higher.
    If intDay2 > intDay1 Then
      intDay2 = intDay1
    End If
  End If
  If Month(datDate2) < Month(DateAdd("d", 1, datDate2)) Then
    ' Date datDate2 is ultimo.
    intDay2 = cintMonthDayUltimo
    ' Decrease date intDate1 if day of datDate1 is higher.
    If intDay1 > intDay2 Then
      intDay1 = intDay2
    End If
  End If
 
  ' Calculate day difference.
  lngDaysDiff = intDay2 - intDay1
  ' Adjust month difference.
  If lngMonths <> 0 Then
    lngReversed = Sgn(lngMonths)
    ' Decrease count of months by one if dates are closer than one month.
    lngMonths = lngMonths - (lngReversed * Abs((lngReversed * lngDaysDiff) < 0))
  End If
  ' Return day count.
  lngDays = lngDaysDiff
  If lngDays <> 0 Then
    If Sgn(lngDays) <> lngReversed Then
      lngDays = lngDays + (lngReversed * cintMonthDayUltimo)
    End If
  End If
  ' Return month count.
  MonthsDays = lngMonths
 
End Function

/gustav