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
|