Need function for determining age 1

[kptasteve]

I need to calculate the age of a child down to the month and day does anyone have a set of code that will give me the age of a child in years months and days??

Steve Marcum PT
Programmer

 

[Eupher]

Try this...

Dim intYearsElapsed As Integer
Dim intMonthsElapsed As Integer
Dim intDaysElapsed As Integer
Dim bdDate As Date
Dim bdYear As Date
Dim bdMonth As Date
Dim strPreciseAge As String

bdDate = Me!txtDate
intYearsElapsed = DateDiff("yyyy", bdDate, Date)
bdYear = DateSerial(Year(Date), Month(bdDate), Day(bdDate))
If Date < bdYear Then
    intYearsElapsed = intYearsElapsed - 1
    bdYear = DateAdd(&quot;yyyy&quot;, -1, bdYear)
End If

intMonthsElapsed = DateDiff(&quot;m&quot;, bdYear, Date)
bdMonth = DateSerial(Year(bdYear), Month(bdDate) + intMonthsElapsed, Day(bdDate))
If Date < bdMonth Then
    intMonthsElapsed = intMonthsElapsed - 1
    bdMonth = DateAdd(&quot;m&quot;, -1, bdMonth)
End If

intDaysElapsed = DateDiff(&quot;d&quot;, bdMonth, Date)

strPreciseAge = intYearsElapsed & &quot; years, &quot; & intMonthsElapsed & &quot; months, &quot; & intDaysElapsed & &quot; days&quot;
MsgBox strPreciseAge

This assumes a text box on your form called "txtDate", but it could just as easily be an input box. Also, there's no error checking to make sure the user entered a valid birthdate. But this should get you started in the right direction.

Ken S.

 

[raskew]

Here's another variation which treats the date parts as integers.

Function AgeCount3(varDOB As Variant, varDate As Variant) As String

On Error GoTo Err_AgeCount3
'
' PURPOSE: Determines the difference between two dates.
'
' ARGUMENTS:  (will accept either dates (e.g., #03/24/00#) or
'              strings (e.g., "03/24/00")

'  varDOB: The earlier of two dates.
'  varDate: The later of two dates.
'
' RETURNS:  A string as years.months.days, e.g., (17.6.21)
'
' NOTES: To test:  Type '? agecount3("03/04/83", "03/23/00")
'                  in the debug window. The function will
'                  return "17.0.19".

Dim dteDOB As Date, dteDate As Date, dteHold As Date
Dim intOldyears As Integer, intOldMonths As Integer, intOldDays As Integer
Dim intNuYears As Integer, intNuMonths As Integer, intNudays As Integer
Dim intYears As Integer, intMonths As Integer, intDays As Integer


If IsDate(varDOB) And IsDate(varDate) Then
   dteDOB = DateValue(varDOB)
   dteDate = DateValue(varDate)
   
  'Reverse the dates if they were input backwards
   If dteDOB > dteDate Then
      dteHold = dteDOB
      dteDOB = dteDate
      dteDate = dteHold
   End If

   intOldyears = Year(dteDOB)
   intOldMonths = Month(dteDOB)
   intOldDays = Day(dteDOB)
   intNuYears = Year(dteDate)
   intNuMonths = Month(dteDate)
   intNudays = Day(dteDate)

   If intNudays < intOldDays Then
      intNudays = intNudays + 30
      intNuMonths = intNuMonths - 1
   End If

   If intNuMonths < intOldMonths Then
      intNuMonths = intNuMonths + 12
      intNuYears = intNuYears - 1
   End If

   intYears = intNuYears - intOldyears
   intMonths = intNuMonths - intOldMonths
   intDays = intNudays - intOldDays

   AgeCount3 = LTrim(Str(intYears)) & &quot;.&quot; & LTrim(Str(intMonths)) & &quot;.&quot; & LTrim(Str(Int(intDays)))
Else
   MsgBox &quot;Invalid date parameters -- please try again&quot;, vbOKOnly, &quot;Check input dates!&quot;
   GoTo Exit_AgeCount3
End If

Exit_AgeCount3:
    Exit Function

Err_AgeCount3:
    Select Case Err.Number
    Case 0
        Resume Next
    Case Else
        MsgBox Err.Number & &quot;: &quot; & Err.Description
    End Select
    Resume Exit_AgeCount3
End Function

 

[MichaelRed]

Public Function basDOB2AgeExt(DOB As Date, Optional AsOf As Date = -1) As String


'Michael Red 5/23/02
'Dob is just the date of Birth
'AsOf is an optional date to check - as in examples 1 & 2
'Otherwise, the DOB is checked against the Current Date

'? basDOB2AgeExt(#8/21/42#)
'59 Years 9 Months and 2 Days.

'? basDOB2AgeExt(#8/21/1942#, #8/20/2022#)
'79 Years 11 Months and 30 Days.

'? basDOB2AgeExt(#8/21/1942#, #8/21/2022#)
'80 Years 0 Months and 0 Days.

Dim tmpAge As Integer 'Simple DateDiff w/o Birthday correction
Dim tmpDt As Date 'Date to use in intermediate Calcs
Dim DtCorr As Boolean 'BirthDay Before or After date in question
Dim YrsAge As Integer
Dim MnthsAge As Integer 'Additional Mnths
Dim DaysAge As Integer 'Additional Days

If (AsOf = -1) Then 'Check for (Optional Date to Check against)
AsOf = Date 'If Not Supplied, Assume Today
End If

tmpAge = DateDiff("YYYY", DOB, AsOf) 'Just the Years considering Jan 1, Mam
DtCorr = DateSerial(Year(AsOf), Month(DOB), Day(DOB)) > AsOf

YrsAge = tmpAge + DtCorr 'Just Years and Correction
tmpDt = DateAdd("yyyy", YrsAge, DOB)

MnthsAge = DateDiff("m", tmpDt, AsOf)
DtCorr = DateAdd("m", MnthsAge, tmpDt) > AsOf
MnthsAge = MnthsAge + DtCorr

tmpDt = DateAdd("m", MnthsAge, tmpDt)
DaysAge = DateDiff("d", tmpDt, AsOf)

basDOB2AgeExt = YrsAge & " Years " & MnthsAge & " Months and " & DaysAge & " Days."

End Function




MichaelRed
m.red@att.net

Searching for employment in all the wrong places

 

[Eupher]

Oops, my solution had a little problem, but I think it's fixed in this version:

Dim intYearsElapsed As Integer
Dim intMonthsElapsed As Integer
Dim intDaysElapsed As Integer
Dim bdDate As Date
Dim bdYear As Date
Dim bdMonth As Date
Dim strPreciseAge As String

bdDate = Me!txtDate
intYearsElapsed = DateDiff("yyyy", bdDate, Date)
bdYear = DateSerial(Year(Date), Month(bdDate), Day(bdDate))
If Date < bdYear Then
    intYearsElapsed = intYearsElapsed - 1
    bdYear = DateAdd(&quot;yyyy&quot;, -1, bdYear)
End If

intMonthsElapsed = DateDiff(&quot;m&quot;, bdYear, Date)
bdMonth = DateSerial(Year(bdYear), Month(bdDate) + intMonthsElapsed, Day(bdDate))
If Month(Date) <> Month(bdMonth) Then
    bdMonth = DateSerial(Year(bdYear), Month(bdDate) + intMonthsElapsed - 1, Day(bdDate))
    intMonthsElapsed = intMonthsElapsed - 1
    ElseIf Date < bdMonth Then
        intMonthsElapsed = intMonthsElapsed - 1
        bdMonth = DateAdd(&quot;m&quot;, -1, bdMonth)
End If

intDaysElapsed = DateDiff(&quot;d&quot;, bdMonth, Date)

strPreciseAge = intYearsElapsed & &quot; years, &quot; & intMonthsElapsed & &quot; months, &quot; & intDaysElapsed & &quot; days&quot;
MsgBox strPreciseAge

However, I think Michael's and raskew's solutions are better code. Just wanted to fix mine in case somebody decided to use it.

Ken S.