Age calculation

[mfnasir@hotmail.com]

Hello,

How to calculate a person's age within two dates? I need to appear in the field as years, months and days.

eg. A person's DOB: 1917.03.08
His DoD : 1975.06.30

Regards

 

[Ranman256]

put this in a public module
USAGE: CalcElapsedTimeAsTxt(date1, date2)

Public Function CalcElapsedTimeAsTxt(ByVal pvDate1, ByVal pvDate2)
Dim lSecs As Long
lSecs = DateDiff("s", pvDate1, pvDate2)
CalcElapsedTimeAsTxt = ElapsedTimeAsTextRecur(lSecs)
End Function


'USAGE:  ElapsedTimeAsTextRecur(655)
Private Function ElapsedTimeAsTextRecur(ByVal pvSecs, Optional ByVal pvSecBlock)
'recursive time lapse given seconds
Dim vTxt
Dim iNum As Long
Const kDAY = 86400
Const kSECpYR = 31536000

'60 sec = 1 min             60 sec
'60 min = 1 hr            3600 sec
'24 hr = 1 day           86400 sec
'7 days = 1 week        604800 sec
'30 days = 1 month     2592000
'12 months = 1 year = 31536000

'YEARS
If IsMissing(pvSecBlock) Then pvSecBlock = kSECpYR
iNum = pvSecs \ pvSecBlock
    
    Select Case pvSecBlock
       Case kSECpYR   'yr
          sUnit = "years"
          If iNum > 0 Then
               vTxt = iNum & " years "
               pvSecs = pvSecs - (iNum * pvSecBlock)
          End If
          vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 2592000)
          
      Case 2592000    'MO
          sUnit = "months"
          If iNum > 0 Then
               If iNum > 11 Then iNum = 11
               vTxt = vTxt & iNum & " months "
               pvSecs = pvSecs - (iNum * pvSecBlock)
          End If
          vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 604800)
       
       Case 604800     'WEEK
          sUnit = "weeks"
          If iNum > 0 Then
               If iNum > 3 Then iNum = 3
               vTxt = vTxt & iNum & " weeks "
               pvSecs = pvSecs - (iNum * kDAY * 7)
          End If
          vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 86400)
       
       Case kDAY      'day
          sUnit = "days"
          If iNum > 0 Then
               vTxt = vTxt & iNum & " days "
               pvSecs = pvSecs - (iNum * kDAY)
          End If
          vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 3600)
       
       Case 3600       'hrs
          sUnit = "hrs"
          If iNum > 23 Then iNum = 23
          If iNum > 0 Then
               vTxt = vTxt & iNum & " hrs "
               pvSecs = pvSecs - (iNum * pvSecBlock)
          End If
          vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 60)
       
       Case 60         'min
          sUnit = "mins"
          If iNum > 0 Then
               vTxt = vTxt & iNum & " mins "
               pvSecs = pvSecs - (iNum * pvSecBlock)
          End If
          vTxt = vTxt & ElapsedTimeAsTextRecur(pvSecs, 1)
       
       Case Else
          
          sUnit = "secs"
          If pvSecs > 0 Then vTxt = vTxt & pvSecs & " seconds"
    End Select
    
ElapsedTimeAsTextRecur = vTxt
End Function

 

[Gasman]

Ranman256,

That does not work for me, presumably due to leap years.?
? CalcElapsedTimeAsTxt(#07/19/1954#,#07/19/2018#)
64 years 2 weeks 2 days

Also sUnit is not defined.

 

[isladogs]

Most age functions only deal with years & months precisely because of leap year issues
Here's another much simpler function that also includes days & seems to work perfectly AFAIK:

Public Function CalcAge(dteDOB As Date, dteEnd As Date) As String
Dim intYears As Integer, intMonths As Integer, intDays As Integer
intMonths = DateDiff("m", dteDOB, dteEnd)
intDays = DateDiff("d", DateAdd("m", intMonths, dteDOB), dteEnd)
If intDays < 0 Then
  intMonths = intMonths - 1
  intDays = DateDiff("d", DateAdd("m", intMonths, dteDOB), dteEnd)
  End If
  intYears = intMonths \ 12
  intMonths = intMonths Mod 12
CalcAge = intYears & " Years, " & intMonths & " Months And " & intDays & " Days"
MsgBox CalcAge
End Function

It seems to handle leap year issues correctly
I can't recall the source of this code

For example:
CalcAge(#07/19/1954#,#07/19/2018#) = 64 Years, 0 Months And 0 Days

Substitute Date() for the second argument to get current age. For example:
CalcAge(#12/25/2017#,Date()) = 0 Years, 7 Months And 3 Days

HTH

 

[Gasman]

That is what I expect would be required in this instance.

Ranman256's code is great for getting the exact period elapsed for other situations though, and I'll be keeping a copy, in case I ever have a need for it.

 

[arnelgp]

for info when a man dies, his age don't advance. it just stayed there.

 

[isladogs]

@arnelgp
Very profound Arnel!
The second date is the DOD.

@Gasman
Here's another function I wrote myself for calculating date and time intervals
Intervals are given in days, hours, minutes & seconds

Function CheckTimeTaken()

    dblStart = CDbl(dteStart)
    dblEnd = CDbl(dteEnd)
    
    dblTimeTaken = dblEnd - dblStart
    
    'Debug.Print dblStart, dblEnd, dblTimeTaken
    
    'This gives the time elapsed in days
    'For simplicity, convert to seconds
    dblTimeTaken = 86400 * dblTimeTaken
    
    'Debug.Print dblTimeTaken
    
    'now create a text string for the time elapsed
    Select Case dblTimeTaken
    
    Case Is < 60
        strTimeTaken = CInt(dblTimeTaken) & " seconds"
    
    Case Is < 3600
        strTimeTaken = CInt(dblTimeTaken \ 60) & " min " & CInt(dblTimeTaken Mod 60) & " sec"
        
    Case Is < 86400
        strTimeTaken = CInt(dblTimeTaken \ 3600) & " hr " & CInt((dblTimeTaken Mod 3600) \ 60) & " min " & CInt(dblTimeTaken Mod 60) & " sec"
        
    Case Is >= 86400
       ' strTimeTaken = "More than 24 hours!"
        strTimeTaken = CInt(dblTimeTaken \ 86400) & " day " & CInt((dblTimeTaken Mod 86400) \ 3600) & " hr " & CInt((dblTimeTaken Mod 3600) \ 60) & " min " & CInt(dblTimeTaken Mod 60) & " sec"
    
    Case Else
        strTimeTaken = "Not known"
        
    End Select

End Function

Sub to test the above

Sub GetTimeTaken()

    dteStart = #10/5/2017 9:13:04 AM#
    dteEnd = #1/7/2018 11:34:25 PM#
    
    CheckTimeTaken
    
    Debug.Print "Time taken = " & strTimeTaken

End Sub

 

[arnelgp]

and another one...

Public Function Age(Date1 As Date, Optional Date2 As Date = 0) As String
Dim Year1 As Integer
Dim Month_1 As Integer
Dim Day1 As Integer
Dim temp As Date
If Date2 = 0 Then Date2 = Date
temp = DateSerial(Year(Date2), Month(Date1), Day(Date1))
Year1 = Year(Date2) - Year(Date1) + (temp > Date2)
Month_1 = Month(Date2) - Month(Date1) - (12 * (temp > Date2))
Day1 = Day(Date2) - Day(Date1)
If Day1 < 0 Then
    Month_1 = Month_1 - 1
    Day1 = Day(DateSerial(Year(Date2), Month(Date2) + 1, 0)) + Day1 + 1
End If
Age = Year1 & " years " & Month_1 & " months " & Day1 & " days"
End Function

 

[ypma]

Arnelgp . i have been following this post and would like to know why a code in the control source could not be used or am i missing something ?

#AgeAtDeath =DateDiff("m",[DOB],[DOD])\12 & " year(s), " & DateDiff("m",[DOB],[DOD]) Mod 12 & " month(s), " & DateDiff("d",[DOB],[DOD]) Mod 7 & " day(s)"#

Regards Ypma

 

[isladogs]

@ypma
You haven't addressed the question at me but your function gives an incorrect answer in my test e.g.
AgeAtDeath(#5/15/1952#,#7/28/2018#) gives 66 year(s), 2 month(s), 2 day(s)

Compare with CalcAge from one of my posts:
CalcAge(#5/15/1952#,#7/28/2018#) gives 66 Years, 2 Months And 13 Days

The latter is the correct answer

EDIT: arnelgp's Age function gives the same result: 66 years 2 months 13 days

 

[ypma]

Ridders , i can't dispute your calculations and have amended my function from MOD 7 to Mod 24 + 1 and it seems now to work is so would this be a fees able alternative to the public function , which i understand could be call for other date differences . I am only trying out different way of skinning the cat.

=DateDiff("m",[DOB],[DOD])\12 & " year(s), " & DateDiff("m",[DOB],[DOD]) Mod 12 & " month(s), " & DateDiff("d",[DOB],[DOD]) Mod 24+1 & " day(s)"

Regards Ypma

only tested on the date you used.

 

[Gasman]

Ridders , i can't dispute your calculations and have amended my function from MOD 7 to Mod 24 + 1 and it seems now to work is so would this be a fees able alternative to the public function , which i understand could be call for other date differences . I am only trying out different way of skinning the cat.

=DateDiff("m",[DOB],[DOD])\12 & " year(s), " & DateDiff("m",[DOB],[DOD]) Mod 12 & " month(s), " & DateDiff("d",[DOB],[DOD]) Mod 24+1 & " day(s)"

Regards Ypma

only tested on the date you used.

I think it might need to be adjusted by a day?

DOB = #7/19/1954#
DOD = #7/19/2018#
gives 64 years and a day?

Whilst technically correct I suppose, I would have thought, if it is your birthday, it would be reported as 64 years only?

 

[isladogs]

Ridders , i can't dispute your calculations and have amended my function from MOD 7 to Mod 24 + 1 and it seems now to work is so would this be a fees able alternative to the public function , which i understand could be call for other date differences . I am only trying out different way of skinning the cat.

=DateDiff("m",[DOB],[DOD])\12 & " year(s), " & DateDiff("m",[DOB],[DOD]) Mod 12 & " month(s), " & DateDiff("d",[DOB],[DOD]) Mod 24+1 & " day(s)"

Regards Ypma

only tested on the date you used.

I think you should abandon this approach

Mod 24 ... where on earth did that come from?

As each month has a different number of days, I can't see how any function using Mod can give correct days in all cases.
Gasman has already given one example where it doesn't work.
Here's another
AgeAtDeath(#5/15/1952#,#7/14/2018#) => 66 year(s), 2 month(s), 23 day(s) - both months & days are wrong!

Correct answer (I hope)
CalcAge(#5/15/1952#,#7/14/2018#) => 66 Years, 1 Months And 29 Days.
The reason its 29 days because June has 30 days

CalcAge(#5/15/1952#,#6/14/2018#) => 66 Years, 0 Months And 30 Days as May has 31 days

Whilst I'm at it:
CalcAge(#2/2/2016#,#3/1/2016#) => 0 Years, 0 Months And 28 Days as 2016 is a leap year
CalcAge(#2/2/2018#,#3/1/2018#) => 0 Years, 0 Months And 27 Days as not a leap year

@Gasman
Belated birthday greetings for 19 July!

 

[ypma]

Ridders. i have thrown in the towel on my effort and appreciate your valued points. It was only a trial and error on my part to see if i could be done ,but i have learnt something in the process which cannot be bad.

Regards Ypma

 

[isladogs]

Hi ypma
TBH - even if it could be done in one line of code, a function saved to a module would be preferable so it can be reused

 

[Mark_]

@ OP,

What are the current rules you use for "Months" when calculating "Years,Months,Days" as months can have a variable number of days.

 

[isladogs]

@ OP,

What are the current rules you use for "Months" when calculating "Years,Months,Days" as months can have a variable number of days.

That shouldn't matter if the age function works correctly
I've just compared the results of the CalcAge function I supplied in post #4 with those for the Age function supplied by arnelgp in post #8

As you can see, both functions give the same result for 5 of the example records.
However there is a discrepancy in 3 cases. I believe the CalcAge function that I supplied (but didn't write) is giving the correct answer in each case.

 

[Mark_]

Colin,

Depending on business rule, "Month" could be calendar month, 30 days, or simply "Not the same month". Gives different results from 25 Aug to 15 Sept depending on HOW you count it. In one case it could be 21 days, in another "One month".

Reason I wanted the OP to be very clear is if they walk us through how THEY expect to calculate each we can make sure we give them a function to return said value.

 

[isladogs]

I accept your point for date differences in general.
However, the OP stated in post 1 that the answer needed to be years, months & days