Saturday, January 31, 2015

Accurate Age Calculator


I never gave thought to calculating an age of a person in terms of years, months and days. But since I read a thread in Foxite pertaining to such need, then I decided to find out how hard it really is.  And it really is not simple as problems appear in months and days.

Anyway, I always try to think beyond the box meaning I do not limit my tools from within VFP itself so I realize a way to do that easy is via automation using Excel.  Excel has this cool function called DATEDIF to get an accurate difference between years, months and days.  So that is where the experiment went.  And here it is:

Public oAge
oAge = Createobject('EMPTY')
AddProperty(oAge,'Year',0)
AddProperty(oAge,'Month',0)
AddProperty(oAge,'Day',0)

Create Cursor junk (Person c(10),birthdate d, enddate d, nYear I, nMonth I, nDay I)
Insert Into junk Values ('Jun',Date(1971,7,13),Date(),0,0,0)
Insert Into junk Values ('Rolly',Date(1952,9,21),Date(),0,0,0)
Insert Into junk Values ('Whoever',Date(2012,6,11),Date(),0,0,0)
Insert Into junk Values ('Baby 1',Date(2014,8,3),Date(),0,0,0)
Insert Into junk Values ('Baby 2',Date(2014,12,29),Date(),0,0,0)

* Create an Excel file
Local loExcel As excel.Application
loExcel = Createobject('excel.application')
With loExcel
      .Workbooks.Add()
      .DisplayAlerts = .F.
Endwith
Scan
      GetAge(birthdate,enddate,loExcel)
      Replace nYear With oAge.Year, nMonth With oAge.Month, nDay With oAge.Day
ENDSCAN

loExcel.Quit
Browse Normal


******
Function GetAge(dBirth, dEnd, loExcel)
*****
With loExcel
      .Cells(1,1).Value = m.dBirth
      .Cells(2,1).Value = m.dEnd
      .Cells(4,1).Value = '=DATEDIF(A1,A2,"Y")'
      .Cells(5,1).Value = '=DATEDIF(A1,A2,"YM")'
      .Cells(6,1).Value = '=DATEDIF(A1,A2,"MD")'
      oAge.Year = .Cells(4,1).Value
      oAge.Month = .Cells(5,1).Value
      oAge.Day  = .Cells(6,1).Value
Endwith
Return


Quite simple, isn't it?  Cheers!

7 comments:

  1. Nice solution.
    As an alternative solution, I propose a VFP procedure.
    LOCAL tnYears,tnMonths,tnDays
    datedif(Date(1971,7,13),Date(2015,1,31),@tnYears,@tnMonths,@tnDays)
    ?tnYears,tnMonths,tnDays
    datedif(Date(1952,9,21),Date(2015,1,31),@tnYears,@tnMonths,@tnDays)
    ?tnYears,tnMonths,tnDays
    datedif(Date(2012,6,11),Date(2015,1,31),@tnYears,@tnMonths,@tnDays)
    ?tnYears,tnMonths,tnDays
    datedif(Date(2014,8,3),Date(2015,1,31),@tnYears,@tnMonths,@tnDays)
    ?tnYears,tnMonths,tnDays
    datedif(Date(2014,12,29),Date(2015,1,31),@tnYears,@tnMonths,@tnDays)
    ?tnYears,tnMonths,tnDays

    *********************************************************************
    * Calculates the number of years, months and days between two dates *
    *********************************************************************
    * Parameters:
    * - td1, td2 (in, required) the two dates
    * - tnYears,tnMonths,tnDays (out, optional), the result
    *********************************************************************
    PROCEDURE datedif
    LPARAMETERS td1,td2,tnYears,tnMonths,tnDays
    LOCAL lnY1,lnM1,lnD1,lnY2,lnM2,lnD2
    IF PCOUNT() < 2
    STORE -1 TO m.tnYears,m.tnMonths,m.tnDays && error
    RETURN
    ENDIF
    IF !INLIST(VARTYPE(m.td1),"D","T")
    STORE -2 TO m.tnYears,m.tnMonths,m.tnDays && error
    RETURN
    ENDIF
    IF m.td1 = m.td2
    STORE 0 TO m.tnYears,m.tnMonths,m.tnDays
    RETURN
    ENDIF
    td1 = MIN(m.td1,m.td2)
    td2 = MAX(m.td1,m.td2)
    lnY1 = YEAR(m.td1)
    lnM1 = MONTH(m.td1)
    lnD1 = DAY(m.td1)
    lnY2 = YEAR(m.td2)
    lnM2 = MONTH(m.td2)
    lnD2 = DAY(m.td2)

    tnYears = m.lnY2 - m.lnY1 - IIF(m.lnM2 * 100 + m.lnD2 < m.lnM1 * 100 + m.lnD1 , 1, 0)
    tnMonths = (m.lnM2 - m.lnM1 + IIF(m.lnD2 < m.lnD1 , 11 , 12)) % 12
    tnDays = IIF(m.lnD2 < m.lnD1, m.td2 - GOMONTH(DATE(m.lnY2,m.lnM2,m.lnD1),-1) , m.lnD2 - m.lnD1)
    ENDPROC

    ReplyDelete
  2. A correction to the last row:
    tnDays = Iif(m.lnD2 < m.lnD1, m.lnD2 + DAY(GOMONTH(DATE(m.lnY1,m.lnM1,1),1) - 1) - m.lnD1 , m.lnD2 - m.lnD1)

    Now the followings will show the correct result
    datedif(Date(2014,3,31),Date(2015,2,28),@tnYears,@tnMonths,@tnDays)
    ?tnYears,tnMonths,tnDays
    datedif(Date(2014,3,30),Date(2015,1,29),@tnYears,@tnMonths,@tnDays)
    ?tnYears,tnMonths,tnDays

    By the way, it seems that Office 2007 SP2 has a bug.
    http://www.excelfox.com/forum/f22/recommendation-do-not-use-the-undocumented-datedif-function-321/

    ReplyDelete
  3. Very nice Vilhelm. I, would of course, prefer the VFP solution as without argument that would be faster. Thanks for that one, I will keep it on my list of useful codes.

    I just wanted others to know though that sometimes we can use outside tools such as excel. :)

    ReplyDelete
  4. Totally agree.
    It was just fun to code this procedure.

    ReplyDelete
    Replies
    1. Not only that! I never realized it can be done by such a short code in VFP itself. Very impressive as usual! :)

      Delete
  5. Hi
    Let me start by saying that I like your articles very much. I read some of them on different occasions, but i never made any comments, due to the fact that usually were very old posts. But today, while I was reading some bits about grids on your site, I came across this one and thought it could be useful some day, so I said I should chip in.
    While the Excel approach is nice and could prove very handy, for some more complex calculations, if the same can be done using only VFP tools I prefer the later.
    Besides the fact that indeed in my version of Excel (2007 SP3) the example from Vilhelm's link still gives a wrong answer (27.06.2011 - 05.01.2012 gives 6M 122D), I wonder if the user needs to have MS Excel installed for this to work ?
    However I think Vilhelm's method is slightly off, because in the case of leap years the result is different from Excel and the last row should be:
    tnDays = Iif(m.lnD2 < m.lnD1, Gomonth(Date(m.lnY2,m.lnM1,m.lnD2),1) - Date(m.lnY2,m.lnM1,m.lnD1) , m.lnD2 - m.lnD1)
    or if u like better:
    tnDays = Iif(m.lnD2 < m.lnD1, m.lnD2 + DAY(GOMONTH(DATE(m.lnY2,m.lnM1,1),1) - 1) - m.lnD1 , m.lnD2 - m.lnD1)

    Now the following will show the correct result:
    datedif(Date(2015,2,28),Date(2016,3,1),@tnYears,@tnMonths,@tnDays)
    ?tnYears,tnMonths,tnDays

    Although English is not my native language I hope that you understood me and want to thank you both. Keep up the good work!

    ReplyDelete
    Replies
    1. Thank you Valentin,

      I love it when people contribute codes. And thanks for the codes. That will be proven useful.

      Delete