|
|
|
| Title | Calculate the number of years, months, days, etc. between two dates |
|---|
| Keywords | dates, age, DateDiff |
|---|
| Categories | Utilities |
|---|
|
|
|
The TimeInterval function finds the difference between two dates in a particular unit: years, months, days, and so forth.
While the start date is more than one year before the end year, the program adds years to the start date.
Then while the start date is more than one month before the end year, the program adds months to the start date.
The function continues like this for days, hours, minutes, and seconds if necessary.
This program gives a good example of using the Calendar control.
Thanks to Jon Kurpias.
|
|
Public Function TimeInterval(StDate As Date, EnDate As _
Date, TimeUnit As Integer)
' args: StartD & EndD
' args: TimeUnit 1=year, 2=month, 3=day, 4=hour,
' 5=minute, 6=second
' returns: integer age in selected unit
Dim SD As Date 'startdate
Dim ED As Date 'enddate
Dim TD As Date 'temp date
Dim x As Integer 'counter
Dim y As Integer 'counter
Dim Unit As String 'yr/mon/day/hr/min/sec
' DateAdd constants
Dim strMsg As String 'msgbox string
Dim UnitFlag As Boolean 'indicates if return value
' is + or -
' check timeunit arg, returns zero if bad
If TimeUnit < 1 Or TimeUnit > 6 Then
strMsg = MsgBox("Time Unit Argument must be integer " & _
"1 to 6", vbOKOnly, "Argumnet Error")
TimeInterval = 0
Exit Function
End If
SD = StDate
ED = EnDate
' set unitflag to + or - & reverse dates if negative
If ED >= SD Then
UnitFlag = True
Else
UnitFlag = False
TD = SD
SD = ED
ED = TD
End If
' work to specified timeunit
For x = 1 To TimeUnit
' for 5 time measurement units ("S" for seconds
' does not calc properly due to rounding errors!)
Select Case x
Case 1
Unit = "YYYY" 'year
Case 2
Unit = "M" 'month
Case 3
Unit = "D" 'day
Case 4
Unit = "H" 'hour
Case 5
Unit = "N" 'minute
Case 6
Unit = "S" 'minute
End Select
' for yr/mon/day/hr/min
If x < 6 Then
' initilize unit counter
y = 0
' increment y & sd unit by 1 unit, until sd > ed
Do While DateAdd(Unit, 1, SD) <= ED
SD = DateAdd(Unit, 1, SD)
y = y + 1
Loop
Else
' use datediff on seconds
y = DateDiff("S", SD, ED)
End If
Next x
TimeInterval = y * IIf(UnitFlag, 1, -1)
End Function
|
|
|
The original version of this program had a bug because it was adding the time unit to the start date until
the date was greater than the stop date. Then it subtracted 1 from the result.
|
|
' increment y & sd unit by 1 unit, until sd > ed
Do While SD <= ED
SD = DateAdd(Unit, 1, SD)
y = y + 1
Loop
' decrement sd by 1 unit
SD = DateAdd(Unit, -1, SD)
|
|
|
This method doesn't work for all dates because adding and then subtracting 1 month from a date does not
always return the original date. For example, this value:
DateAdd("M", -1, DateAdd("M", 1, "3/31/02"))
returns 3/30/02. This type of error occurs whenever the date is at the end of a month that has more
days than the following month.
|
| |
|
| |
|
|
