Wrox Programmer Forums calculating a persons age
 |
 Access VBA Discuss using VBA for Access programming.
 Welcome to the p2p.wrox.com Forums. You are currently viewing the Access VBA section of the Wrox Programmer to Programmer discussions. This is a community of software programmers and website developers including Wrox book authors and readers. New member registration was closed in 2019. New posts were shut off and the site was archived into this static format as of October 1, 2020. If you require technical support for a Wrox book please contact http://hub.wiley.com

January 25th, 2005, 09:09 AM
 Hudson40 Authorized User Join Date: Dec 2004 Posts: 43 Thanks: 0 Thanked 0 Times in 0 Posts
calculating a persons age

Hi

Does anybody know trhe function for calculating someones age. I have used a function which uses the following:

DateDiff("d", vFromDate, vToDate)

but it does not calculate the person age entirely acurately. I need the age to be spot on.

Cheers

Cheers
Tony
__________________
Cheers
Tony

January 25th, 2005, 10:23 AM
 elansolutionsltd Authorized User Join Date: Jul 2004 Posts: 46 Thanks: 0 Thanked 1 Time in 1 Post

This might not be the quickest way to do it, but it works and the code can be amended to do practically anything

Sub agecalc()
Dim dob As Date, calc_date As Date
Dim yb As Integer, mb As Integer, db As Integer
Dim yc As Integer, mc As Integer, dc As Integer
Dim diff1 As Integer, diff2 As Integer

dob = InputBox("Enter date of birth")
calc_date = InputBox("Enter calculation date")

yb = Year(dob)
mb = Month(dob)
db = Day(dob)

yc = Year(calc_date)
mc = Month(calc_date)
dc = Day(calc_date)

'---if this year's birthday is AFTER calculation date
If DateSerial(yc, mc, dc) >= DateSerial(yc, mb, db) Then
diff1 = yc - yb
diff2 = DateDiff("d", DateSerial(yc, mb, db), DateSerial(yc, mc, dc))
MsgBox "Age is " & Str(diff1) & " years and " & Str(diff2) & " days"
End If

'---if this year's birthday is BEFORE calculation date
If DateSerial(yc, mc, dc) < DateSerial(yc, mb, db) Then
diff1 = yc - yb - 1
diff2 = DateDiff("d", DateSerial(yc - 1, mc, dc), DateSerial(yc, mb, db))
MsgBox "Age is " & Str(diff1) & " years and " & Str(diff2) & " days"
End If

End Sub

Hope this helps

Alan T

January 25th, 2005, 12:50 PM
 Hudson40 Authorized User Join Date: Dec 2004 Posts: 43 Thanks: 0 Thanked 0 Times in 0 Posts

Brilliant Alan...works a treat

cheers

Cheers
Tony

January 26th, 2005, 08:41 AM
 mmcdonal Friend of Wrox Join Date: Mar 2004 Posts: 3,069 Thanks: 0 Thanked 10 Times in 10 Posts

This will do it too:

'=========================
Function Age (varBirthDate As Variant) As Integer
Dim varAge As Variant

If IsNull(varBirthdate) then Age = 0: Exit Function

varAge = DateDiff("yyyy", varBirthDate, Now)
If Date < DateSerial(Year(Now), Month(varBirthDate), _
Day(varBirthDate)) Then
varAge = varAge - 1
End If
Age = CInt(varAge)
End Function
'========================================

mmcdonal

January 26th, 2005, 11:45 AM
 BrianWren Friend of Wrox Join Date: Nov 2004 Posts: 1,621 Thanks: 1 Thanked 3 Times in 3 Posts

BTW (just in passing),

If IsNull(varBirthdate) Then Exit Function

will work exactly the same as

If IsNull(varBirthdate) Then Age = 0: Exit Function

Integers default to 0, and the function return value follows that methodology.

For me (might be different for others) the version that just exits is easier to read (and we all have to come back and read our code later...), and I believe it will run about 18 nano-seconds faster.

 Similar Threads Thread Thread Starter Forum Replies Last Post Age Calculation rgerald SQL Server 2000 32 October 10th, 2007 01:12 AM Select fields & calculating age miki-pt Access ASP 1 November 26th, 2006 06:16 PM age function keyvanjan ASP.NET 1.0 and 1.1 Basics 2 August 30th, 2006 08:46 AM Vacancy Age alannoble26 Excel VBA 2 November 23rd, 2005 03:05 AM Calculating and filtering age based on date shawnm Classic ASP Databases 4 November 12th, 2005 06:08 AM