[AccessD] Age Calculation - Yeah, I'm going there again!

Gustav Brock gustav at cactus.dk
Fri May 20 08:27:08 CDT 2011


Hi John

Here is how:

Public Function Months( _
  ByVal datDate1 As Date, _
  ByVal datDate2 As Date, _
  Optional ByVal booLinear As Boolean) _
  As Integer

' Returns the difference in full months between datDate1 and datDate2.
'
' 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)
'
' Optionally returns negative counts rounded down to provide a
' linear sequence of month counts.
' For a given datDate1, if datDate2 is decreased stepwise one month from
' returning a positive count to returning a negative count, one or two
' occurrences of count zero will be returned.
' If booLinear is False, the sequence will be:
'   3, 2, 1, 0,  0, -1, -2
' If booLinear is True, the sequence will be:
'   3, 2, 1, 0, -1, -2, -3
'
' If booLinear is False, reversing datDate1 and datDate2 will return
' results of same absolute Value, only the sign will change.
' This behaviour mimics that of Fix().
' If booLinear is True, reversing datDate1 and datDate2 will return
' results where the negative count is offset by -1.
' This behaviour mimics that of Int().

' DateAdd() is used for check for month end of February as it correctly
' returns Feb. 28. when adding a count of months to dates of Feb. 29.
' when the resulting year is a common year.
'
' 2010-03-30. Cactus Data ApS, CPH.

  Dim intDiff   As Integer
  Dim intSign   As Integer
  Dim intMonths As Integer
  
  ' Find difference in calendar months.
  intMonths = DateDiff("m", datDate1, datDate2)
  ' For positive resp. negative intervals, check if the second date
  ' falls before, on, or after the crossing date for a 1 month period
  ' while at the same time correcting for February 29. of leap years.
  If DateDiff("d", datDate1, datDate2) > 0 Then
    intSign = Sgn(DateDiff("d", DateAdd("m", intMonths, datDate1), datDate2))
    intDiff = Abs(intSign < 0)
  Else
    intSign = Sgn(DateDiff("d", DateAdd("m", -intMonths, datDate2), datDate1))
    If intSign <> 0 Then
      ' Offset negative count of months to continuous sequence if requested.
      intDiff = Abs(booLinear)
    End If
    intDiff = intDiff - Abs(intSign < 0)
  End If
  
  ' Return count of months as count of full 1 month periods.
  Months = intMonths - intDiff
  
End Function


To have the years and months count:

intMonths = Months([DOB], Date)
strYearsMonths = CStr(intMonths \ 12) & " year(s), " & CStr(intMonths Mod 12) & " month(s)"

/gustav


>>> John.Clark at niagaracounty.com 19-05-2011 17:57 >>>
I've got this quickie program I whipped up, that our health department wants to use, for entering and tracking surveyed data regarding children and dental visits. There are 3 separate surveys depending on the childs age, and this can change as the child ages. 
 
I've pretty much got the whole thing done, but...one of their age groups is "6 Months to 4 Yrs of Age." This really doesn't matter to me, because it is irrelevant in the program...I check for "under 4 yrs" for this group. But, they want the yrs and months to show for age. And, of course, my only code just give age in years. 
 
Anyone have code that does age in yrs and months?
 
Thanks ahead of time!
 
J Clark





More information about the AccessD mailing list