Wrox Programmer Forums
| Search | Today's Posts | Mark Forums Read
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
 
Old January 25th, 2005, 09:09 AM
Authorized User
 
Join Date: Dec 2004
Location: Belfast, Antrim, United Kingdom.
Posts: 43
Thanks: 0
Thanked 0 Times in 0 Posts
Default 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
 
Old January 25th, 2005, 10:23 AM
Authorized User
 
Join Date: Jul 2004
Location: clapton-in-gordano, n.somerset, United Kingdom.
Posts: 46
Thanks: 0
Thanked 1 Time in 1 Post
Default

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


 
Old January 25th, 2005, 12:50 PM
Authorized User
 
Join Date: Dec 2004
Location: Belfast, Antrim, United Kingdom.
Posts: 43
Thanks: 0
Thanked 0 Times in 0 Posts
Default

Brilliant Alan...works a treat

cheers

Cheers
Tony
 
Old January 26th, 2005, 08:41 AM
Friend of Wrox
Points: 9,611, Level: 42
Points: 9,611, Level: 42 Points: 9,611, Level: 42 Points: 9,611, Level: 42
Activity: 0%
Activity: 0% Activity: 0% Activity: 0%
 
Join Date: Mar 2004
Location: Washington, DC, USA.
Posts: 3,069
Thanks: 0
Thanked 10 Times in 10 Posts
Default

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
 
Old January 26th, 2005, 11:45 AM
Friend of Wrox
 
Join Date: Nov 2004
Location: Port Orchard, WA, USA.
Posts: 1,621
Thanks: 1
Thanked 3 Times in 3 Posts
Default

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





Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
Copyright (c) 2020 John Wiley & Sons, Inc.