Calc Date Years Month Days from DOB to DOD

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

Hi,
I'm trying to calc Years Months and Days from DOB to DOD. Years and Months
work, Days does not.
Can you help? Thanks Buddy - Problem also when DOB = 07/01/2006 DOD =
07/02/2006

'CALC Years
Function CalcAge(varDOB As Variant) As Integer
Dim varAge As Variant


If IsNull(varDOB) Then CalcAge = 0: Exit Function

varAge = DateDiff("yyyy", varDOB, xNow)
If Date < DateSerial(Year(xNow), Month(varDOB), Day(varDOB)) Then
varAge = varAge - 1
Else
End If
If xNow >= DateSerial(Year(xNow), Month(varDOB), Day(varDOB)) Then
CalcAge = CInt(varAge)
Else
'CalcAge = CInt(varAge)
End If
End Function

'CALC Months
Function CalcMonths(ByVal varDOB As String) As Integer

Dim tAge As Double
If IsNull(varDOB) Then tAge = 0: Exit Function
tAge = (DateDiff("m", varDOB, xNow))
If (DatePart("d", varDOB) > DatePart("d", xNow)) Then
tAge = tAge - 1
End If

If tAge < 0 Then
tAge = tAge + 1
End If
CalcMonths = CInt(tAge Mod 12)

End Function

'CALC Days
Function CalcDays(varDOB As Date) As Integer
Dim intDays As Integer

' Add one month, subtract dates to find difference.
intDays = DateSerial(Year(xNow), Month(xNow) - 1, Day(xNow)) _
- DateSerial(Year(varDOB), Month(varDOB), Day(varDOB))
CalcDays = intDays
'Debug.Print intDays

vDays = DateDiff("d", DateAdd("m", vMOnths, varDOB), xNow)
If IsNull(vDays) Then
vDays = 0
Else: End If
If vDays < 0 Then
' wierd way that DateDiff works, fix it here
'vMonths = vMonths - 1
vDays = DateDiff("d", DateAdd("m", vMOnths, varDOB), xNow)
End If
vYears = vMOnths \ 12 ' integer division
vMOnths = vMOnths Mod 12 ' only want leftover less than one year

End Function
 
Hi,
I'm trying to calc Years Months and Days from DOB to DOD. Years and Months
work, Days does not.
Can you help? Thanks Buddy - Problem also when DOB = 07/01/2006 DOD =
07/02/2006

'CALC Years
Function CalcAge(varDOB As Variant) As Integer
Dim varAge As Variant


If IsNull(varDOB) Then CalcAge = 0: Exit Function

varAge = DateDiff("yyyy", varDOB, xNow)
If Date < DateSerial(Year(xNow), Month(varDOB), Day(varDOB)) Then
varAge = varAge - 1
Else
End If
If xNow >= DateSerial(Year(xNow), Month(varDOB), Day(varDOB)) Then
CalcAge = CInt(varAge)
Else
'CalcAge = CInt(varAge)
End If
End Function

'CALC Months
Function CalcMonths(ByVal varDOB As String) As Integer

Dim tAge As Double
If IsNull(varDOB) Then tAge = 0: Exit Function
tAge = (DateDiff("m", varDOB, xNow))
If (DatePart("d", varDOB) > DatePart("d", xNow)) Then
tAge = tAge - 1
End If

If tAge < 0 Then
tAge = tAge + 1
End If
CalcMonths = CInt(tAge Mod 12)

End Function

'CALC Days
Function CalcDays(varDOB As Date) As Integer
Dim intDays As Integer

' Add one month, subtract dates to find difference.
intDays = DateSerial(Year(xNow), Month(xNow) - 1, Day(xNow)) _
- DateSerial(Year(varDOB), Month(varDOB), Day(varDOB))
CalcDays = intDays
'Debug.Print intDays

vDays = DateDiff("d", DateAdd("m", vMOnths, varDOB), xNow)
If IsNull(vDays) Then
vDays = 0
Else: End If
If vDays < 0 Then
' wierd way that DateDiff works, fix it here
'vMonths = vMonths - 1
vDays = DateDiff("d", DateAdd("m", vMOnths, varDOB), xNow)
End If
vYears = vMOnths \ 12 ' integer division
vMOnths = vMOnths Mod 12 ' only want leftover less than one year

End Function
Click to expand...

See "A More Complete DateDiff Function" at
http://www.accessmvp.com/djsteele/Diff2Dates.html
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Age from Date Function 5
Age Calculation 3
Calculate date of birth 2
calculate age function utilization 5
basage modular 4
How to update table with calculated form value? 6
Age from Dob 12
Full Age in report 1

Back
Top