Solved Age calculatoion Function

[Falcon88]

I search for a function to return the age and find
http://allenbrowne.com/func-08.html

But i want years with months
If less than year returned months only

???

 

[Gasman]

Search here. @arnelgp has posted several variations.

 

[DHookom]

Doug Steele has a more complete age calculation function.

 

[plog]

But i want years with months
If less than year returned months only

The devil is in the edges. The most granular calendar unit is the day--every other unit can be expressed in days...but not consistently. Months come with 28,29,30 & 31 days. Years come with 365 & 366 days. Exactly where and how do you want to draw your line?

Born July 1. Today is August 31. They are 62 days old. How many months you do expect returned? What exact date does it switch from 1 month to 2 months? What exact date does it switch from 2 months to 3 months?

Born January 31. Today is March 1. They are 29 days old. How many months do you expect returned? What exact date does it switch from 0 months to 1 month? What exact date does it switch from 1 month to 2 months?

 

[isladogs]

See also my article which has a wide variety of age functions depending on your requirements:

Calculate Age

This article includes several functions to calculate age in years, years & months or years, months and days. It even has a function to calculate age in Years, Months, Days, Hours, Minutes And Seconds!

www.isladogs.co.uk

 

[Ken Sheridan]

But i want years with months
If less than year returned months only

Try the following functions. I've amended the line which sets the return value of the first function, so that it suppresses the zero if the return value is less than one year:

Public Function GetAgeYearsMonths(varDoB As Variant, Optional varAgeAt As Variant) As Variant

    Dim intYears As Integer
    Dim intMonths As Integer

    If IsMissing(varAgeAt) Or IsNull(varAgeAt) Then varAgeAt = VBA.Date
      
    If Not IsNull(varDoB) Then
        intYears = GetAge(varDoB, True, varAgeAt)
        intMonths = DateDiff("m", varDoB, varAgeAt) - (intYears * 12)

        If Day(varDoB) > Day(varAgeAt) Then
            intMonths = intMonths - 1
        End If
            
        ' adjust for leap year if necessary
        If IsLeapDate(varDoB) And Month(varAgeAt) = 2 And Day(varAgeAt) = 28 And Not IsLeapDate(varAgeAt + 1) Then
            intMonths = 0
        End If
    
        GetAgeYearsMonths = IIf(intYears > 0, intYears & ":", Null) & intMonths
    End If
    
End Function


Public Function IsLeapDate(ByVal dtmDate As Date) As Boolean

    If Month(dtmDate) = 2 And Day(dtmDate) = 29 Then
        IsLeapDate = True
    End If
    
End Function

 

[Gasman]

@Ken Sheridan
GetAge function is missing?

I suppose one could always replace 0 Years with nothing?

 

[arnelgp]

you can also try this:

Public Function AgeInYearMo(ByVal dob As Date) As String

    Dim m As Integer, y As Integer
    Dim u As String, s As String
   
    m = DateDiff("m", dob, Date)
    y = m \ 12
    If m < 13 Then
        AgeInYearMo = m & " month" & IIf(m > 1, "s", "")
    Else
        m = m Mod 12
        If m <> 0 Then
            u = m & " month" & IIf(m > 1, "s", "")
        End If
        s = y & " year" & IIf(y > 1, "s", "")
        If Len(u) <> 0 Then
            s = s & " and " & u
        End If
        AgeInYearMo = s
       
    End If
End Function

 

[Pat Hartman]

Here's a sample with many date functions.

Sample Date Functions

This database contains a number of date functions that you can simply copy into your application. There is a tabbed form to show you how to use the calculations. A partial list of functions is: Business days between two dates. Business day + days = next business date Easter (Western) Age...

www.access-programmers.co.uk

 

[Ken Sheridan]

GetAge function is missing?

Doh!

Public Function GetAge(varDoB As Variant, blnFebLeapAnniversary As Boolean, Optional varAgeAt As Variant) As Variant

    ' Returns:  Age in years as an integer.
    ' Accepts:  varDoB; date/time value
    '           blnFebLeapAnniversary; Boolean constant, TRUE if anniversary
    '           of 29 February birthday is 28 February, FALSE if is 1 March.
    '           varAgeAt; date/time value, optional; date at which age to be computed,
    '           defaults to current date.
    
    If Not IsNull(varDoB) Then
        If IsMissing(varAgeAt) Then varAgeAt = VBA.Date
        
        GetAge = DateDiff("yyyy", varDoB, varAgeAt) - _
            IIf(Format(varAgeAt, "mmdd") < Format(varDoB, "mmdd"), 1, 0)
    
        ' adjust for leap year if necessary
        If blnFebLeapAnniversary Then
            If IsLeapDate(varDoB) And Month(varAgeAt) = 2 And Day(varAgeAt) = 28 And Not IsLeapDate(varAgeAt + 1) Then
                GetAge = GetAge + 1
            End If
        End If
    End If
    
End Function

My amendment to the GetAgeYearsMonths function replaces a 0 years value with Null:

GetAgeYearsMonths = IIf(intYears > 0, intYears & ":", Null) & intMonths

 

[Gasman]

My thoughts were to use 'as is' if none of the offerings were exactly what the O/P wanted, and then just replace any '0 Years And'
Need to also do the same for 1 Month using Month and not Months, even Year and Years?

? Replace(GetAgeYearsMonths(#07/19/2025#,date()),"0 Years And ","")
1 Months
0 Years And 1 Months

    'GetAgeYearsMonths = IIf(intYears > 0, intYears & ":", Null) & intMonths
     GetAgeYearsMonths = IIf(intYears > 0, intYears & ":", 0) & " Years And " & intMonths & " Month" & IIf(intMonths > 1, "s", "")

 

[RonPaii]

Calculate number of months in the year of the date and number of years to now

Public Function AgeInYearMonth(ByVal DateToCheck As Date) As String
    Dim Months As Long
    Dim Years As Long
    If DateToCheck < Now Then
        Months _
            = DateDiff("m", _
                       DateToCheck, _
                       DateSerial(Year(DateToCheck), _
                                  Month(Now), _
                                  1))
        Years _
            = Year(Now) _
            - Year(DateToCheck)
    End If
    AgeInYearMonth = Years & " Years, " & Months & " Months"
End Function

Or ugly inline code

year(now)-Year(#7/31/2005#) & " Years, " & datediff("m",#7/31/2005#,dateserial(year(#7/31/2005#),month(now),1)) & " Months"