I am going mad!!

[Greg Maxey]

I need a smart guy or gal to help me regain my sanity. I pulled a macro off
Google that would calculate a person's age based on a today's date and their
birthdate. I am setting two date variables with a calendar control
(stripped out here) and I am trying to extend the macro to calculate down to
the hours and minutes.

At first glance it look easy enough, but I started hitting walls
(figuratively and litterally) when my test involved spans over a day. For
example the code would always return 1 Day even if the the variables where

01/24/05 23:59 and 01/25/05 00:01. While that is a day when generally
speaking of someone's age, it is more like, actually just like, 2 minutes.

I finally put together the following, which I think is working. That only
means that I haven't found a way to break it. The output is rather crude,
but you can get the jist of it. I would appreciate any feedback or comments
on any shortcomings any of you may see or suggestions for improvement. I
feel like that there is a complex formula similiar to the years, months, and
days portition which is someone else's work, but I can figure it out.

Sub CalcTimeSpan()
Dim Years As Integer
Dim Months As Integer
Dim Days As Integer
Dim DaysInMonth As Integer
Dim Hours As Integer
Dim Minutes As Integer
Dim FirstDate As Date
Dim SecondDate As Date


FirstDate = "01/24/05 21:00"
SecondDate = Date


If SecondDate < FirstDate Then
MsgBox "Set the earlier date as the first anchor date"
End If

On Error GoTo ExitSub
If (Month(SecondDate) = 2) Then
DaysInMonth = 28 + (Month(SecondDate) = 2) * ((Year(SecondDate) Mod 4 = 0)
_
+ (Year(SecondDate) Mod 400 = 0) - (Year(SecondDate) Mod 100 =
0))
Else
DaysInMonth = 31 - (Month(SecondDate) = 4) - (Month(SecondDate) = 6) _
- (Month(SecondDate) = 9) - (Month(SecondDate) = 11)
End If
Years = Year(SecondDate) - Year(FirstDate) + (Month(SecondDate) _
< Month(FirstDate)) + (Month(SecondDate) = Month(FirstDate)) _
* (Day(SecondDate) < Day(FirstDate))
Months = (12 + Month(SecondDate) - Month(FirstDate) + (Day(SecondDate) _
< Day(FirstDate))) Mod 12
Days = (DaysInMonth + Day(SecondDate) - Day(FirstDate)) Mod DaysInMonth
If Hour(SecondDate) < Hour(FirstDate) Then
Hours = Hour(SecondDate) - Hour(FirstDate) + 24
Else: Hours = Hour(SecondDate) - Hour(FirstDate)
End If
Minutes = Minute(SecondDate) - Minute(FirstDate)
If Hour(SecondTime) < Hour(FirstTime) Then Days = Days - 1
MsgBox Years & Months & Days & Hours & Minutes
ExitSub:
End Sub

 

[Klaus Linke]

Hi Greg,

Looks like you solved it... But have you looked at DateDiff in the VBA help?

Greetings,
Klaus

 

[Helmut Weber]

Hi Greg,
calculating things like that are always a special challenge,
as whether months nor years have a fixed length.
My own quirk approach, goes like this:

Dim TimeThn As Double ' "Time then" as long isn't long enough
Dim TimeNow As Double ' neither seems to be single

Transform now and date and time of birth to YYYYMMDDHHMMSS.

TimeThn = 18491106121212#
TimeNow = 20051106121212#
....
MsgBox TimeNow - TimeThn ' 156 plus x

TimeThn = 19491106121212#
TimeNow = 20051106121212#
MsgBox TimeNow - TimeThn ' 56 plus x

TimeThn = 19491106121212#
TimeNow = 20051106121211#
MsgBox TimeNow - TimeThn ' 55 plus x

Remains the problem, how many digits from left of TimeNow - TimeThn
should be evaluated. I knew it, but can't remember.

Greetings from Bavaria, Germany

Helmut Weber, MVP
"red.sys" & chr(64) & "t-online.de"
Word XP, Win 98
http://word.mvps.org/

 

[Andi Mayer]

I need a smart guy or gal to help me regain my sanity. I pulled a macro off
Google that would calculate a person's age based on a today's date and their
birthdate. I am setting two date variables with a calendar control
(stripped out here) and I am trying to extend the macro to calculate down to
the hours and minutes.

Greg your googling skills are not very good

this is German
http://www.donkarl.com/FAQ/FAQ2Allgemein.htm#2.7

this is english:
http://www.mvps.org/access/datetime/date0001.htm

 

[Greg]

Andi,

I found a perfectly good calculator for determining age very similiar
to the method in your link.

The problem is that these methods stops at Days. I was born 12/31/58
these calculators return 46 years 26 days.

I was born at 16:00 it is 12:05 now. My age is 46 years, 25 days, 20
hours and 5 minutes. It is not that I care that much about my age, I
am working on a formula to extend the calculation to hours and minutes.

 

[Greg]

Helmut,

I will have a look at this. The method I am using is working, it just
seems like it shouldn't and therefore I am concerned that some
combination of date and time will trip it off line

 

[Greg]

Klaus,

Yes. Sometimes the VBA help gets me more scatter brained, especially
late at night. I thought DateDiff would only report a numerical value
representing the specified period between two dates. I will look
further.

 

[Andi Mayer]

this this fit your needs?


Public Sub CalcAge(vDate1 As Date, _
vdate2 As Date, _
ByRef vYears As Integer, _
ByRef vMonths As Integer, _
ByRef vDays As Integer, _
ByRef vHours As Integer, _
ByRef vMin As Integer)
' Comments : calculates the age in Years, Months and Days
' original :http://www.mvps.org/access/datetime/date0001.htm
' Parameters:
' vDate1 - D.O.B.
' vDate2 - Date to calculate age based on
' vYears - will hold the Years difference
' vMonths - will hold the Months difference
' vDays - will hold the Days difference
' vhours - will hold the Hours difference
' vMin - will hold the Minutes difference
vMonths = DateDiff("m", vDate1, vdate2)
vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2)
If vDays < 0 Then
' wierd way that DateDiff works, fix it here
vMonths = vMonths - 1
vDays = DateDiff("d", DateAdd("m", vMonths, vDate1), vdate2)
End If
vYears = vMonths \ 12 ' integer division
vMonths = vMonths Mod 12 ' only want leftover less than one year

Dim tmp1 As Long, tmp2 As Long, difTmp As Long
tmp1 = Hour(vDate1) * 3600 + Minute(vDate1) * 60 + Second(vDate1)
tmp2 = Hour(vdate2) * 3600 + Minute(vdate2) * 60 + Second(vdate2)
difTmp = tmp2 - tmp1
If difTmp < 0 Then
difTmp = 86400 + difTmp
vDays = vDays - 1
End If
vHours = Int(difTmp / 3600)
vMin = Int((difTmp Mod 3600) / 60)

End Sub

Sub PrintTheAge()
Dim aa As Integer, bb As Integer, cc As Integer, dd As Integer, ee As
Integer
CalcAge #12/31/1958 4:00:00 PM#, #1/26/2005 12:05:00 PM#, aa, bb, cc,
dd, ee
Debug.Print aa, bb, cc, dd, ee
End Sub

 

[Greg Maxey]

Andi,

Thanks. I will have a look at this in more detail soon.

 

[Greg Maxey]

Andi,

Thanks. While my method seemed to work, I shelved it in favor of yours. It
seems the like the approach that developers of VB intended.

 

[Word Heretic]

G'day "Greg Maxey" <[email protected]>,


Mate - use the DateDiff command - does all the hard work for you!


Steve Hudson - Word Heretic

steve from wordheretic.com (Email replies require payment)
Without prejudice


Greg Maxey reckoned: