 |
| 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
|
|
Authorized User
|
|
Join Date: Dec 2004
Location: Belfast, Antrim, United Kingdom.
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
|
|
Authorized User
|
|
Join Date: Jul 2004
Location: clapton-in-gordano, n.somerset, United Kingdom.
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
|
|
Authorized User
|
|
Join Date: Dec 2004
Location: Belfast, Antrim, United Kingdom.
Posts: 43
Thanks: 0
Thanked 0 Times in 0 Posts
|
|
Brilliant Alan...works a treat
cheers
Cheers
Tony
|
|
January 26th, 2005, 08:41 AM
|
|
Friend of Wrox
|
|
Join Date: Mar 2004
Location: Washington, DC, USA.
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
|
|
Friend of Wrox
|
|
Join Date: Nov 2004
Location: Port Orchard, WA, USA.
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
