Code to make dates easier to read
Today's author: Kerry Westphal, a program manager who works on the Access team.
I like how many web 2.0 applications make it very easy to visualize complex data quickly. I found myself recently challenged with this task while working on a project where I wanted to display on a report an easy way to show the time elapsed between the current date and another date. Example scenarios how long it’s been since a user profile has been updated, the time left until taxes are due or how long a library book has been checked out. I didn’t just want to show the hours or even days elapsed, but something more in sync with the way I want the information given to me- specifically that when dates are closer to the current time they are represented more precisely and dates that are farther away are shown generically. I checked out Sal Ricciardi’s article On Time and how much has elapsed to get me started on this work.
By extending his functions I found just what I was looking for. I wrote the ElapsedDays function along with some helper functions to accomplish this task. The function can be used in a query to obtain a string representation of the time elapsed. The string returned is specific or general based on the time elapsed. For example, if the date is very close to the current date, it would say something like “In 12 hours, 27 minutes”. But if the date was sometime much longer ago, it would return something more general like, “Over a year ago”. Here is an example where I used the ElapsedDays function to keep track of items in my calendar:
Here is the code. Feel free to use it in your applications to help read dates faster with more clarity.
Public Function ElapsedDays(dateTimeStart As Date) _
As String
'*************************************************************
' Function ElapsedDays(dateTimeStart As Date) As String
' Returns the time elapsed from today in a friendly string like,
' "A day ago"
'*************************************************************
Dim interval As Double, days As Variant
If IsNull(dateTimeStart) = True Then Exit Function
days = dateTimeStart - Now()
Dim leapYearNow
Dim leapYearBefore
If WhenLeapYear() = 1 Then
leapYearNow = 366
leapYearBefore = 365
Else:
If WhenLeapYear() = 2 Then
leapYearNow = 365
leapYearBefore = 366
Else
leapYearNow = 365
leapYearBefore = 365
End If
End If
Select Case days
Case Is < -leapYearBefore
ElapsedDays = "Over a year ago"
Case -leapYearBefore To -MonthTime(5) + -MonthTime(4)
ElapsedDays = "In the last year"
Case -MonthTime(5) + -MonthTime(4) To -MonthTime(4)
ElapsedDays = "Over a month ago"
Case -MonthTime(4) To -28
ElapsedDays = "Over four weeks ago"
Case -28 To -21
ElapsedDays = "Over three weeks ago"
Case -21 To -13
ElapsedDays = "Over two weeks ago"
Case -13 To -7
ElapsedDays = "Over a week ago"
Case -7 To -6
ElapsedDays = "Over six days ago"
Case -6 To -5
ElapsedDays = "Over five days ago"
Case -5 To -4
ElapsedDays = "Over four days ago"
Case -4 To -3
ElapsedDays = "Over three days ago"
Case -3 To -2
ElapsedDays = "Over two days ago"
Case -2 To -1
ElapsedDays = "Over a day ago"
Case -1 To 0
ElapsedDays = ElapsedTimeString(dateTimeStart) & " ago"
Case 0 To 1
ElapsedDays = "In " & ElapsedTimeString(dateTimeStart)
Case 1 To 2
ElapsedDays = "In over one day"
Case 2 To 3
ElapsedDays = "In over two days"
Case 3 To 4
ElapsedDays = "In over three days"
Case 4 To 5
ElapsedDays = "In over four days"
Case 5 To 6
ElapsedDays = "In over five days"
Case 6 To 7
ElapsedDays = "In over six days"
Case 7 To 14
ElapsedDays = "In over a week"
Case 14 To 21
ElapsedDays = "In over two weeks"
Case 21 To 28
ElapsedDays = "In over three weeks"
Case 28 To MonthTime(1)
ElapsedDays = "In over four weeks"
Case MonthTime(1) To MonthTime(2) + MonthTime(1)
ElapsedDays = "In over a month"
Case MonthTime(2) + MonthTime(1) To MonthTime(3) + MonthTime(2) + MonthTime(1)
ElapsedDays = "In over two months"
Case MonthTime(3) + MonthTime(2) + MonthTime(1) To leapYearNow
ElapsedDays = "In less than a year"
Case Is > leapYearNow
ElapsedDays = "In over a year"
End Select
If ElapsedDays = "0 ago" Or ElapsedDays = "In 0" Then ElapsedDays = "Now"
End Function
Public Function IsLeapYear()
Dim leap As Variant
leap = DatePart("yyyy", Now())
If (leap Mod 4 = 0) And ((leap Mod 100 <> 0) Or (leap Mod 400 = 0)) Then IsLeapYear = 29 Else IsLeapYear = 28
End Function
Public Function WhenLeapYear()
Dim leap As Variant
leap = DatePart("yyyy", Now())
If (leap Mod 4 = 0) And ((leap Mod 100 <> 0) Or (leap Mod 400 = 0)) Then
WhenLeapYear = 1
Exit Function
Else
leap = leap - 1
If (leap Mod 4 = 0) And ((leap Mod 100 <> 0) Or (leap Mod 400 = 0)) Then
WhenLeapYear = 2
Exit Function
Else:
WhenLeapYear = 3
End If
End If
End Function
Public Function MonthTime() _
As Variant
Dim month As Variant
Dim MonthTime1(5) As Variant
month = DatePart("m", Now())
Select Case month
Case 1 'January
MonthTime1(1) = 31 'January
MonthTime1(2) = IsLeapYear() 'February
MonthTime1(3) = 31 'March
MonthTime1(4) = 31 'December
MonthTime1(5) = 30 'November
Case 2 ' February
MonthTime1(1) = IsLeapYear() 'February
MonthTime1(2) = 31 'March
MonthTime1(3) = 30 'April
MonthTime1(4) = 31 'January
MonthTime1(5) = 31 'December
Case 3 'March
MonthTime1(1) = 31 'March
MonthTime1(2) = 30 'April
MonthTime1(3) = 31 'May
MonthTime1(4) = IsLeapYear() ' February
MonthTime1(5) = 31 'January
Case 4 'April
MonthTime1(1) = 30 'April
MonthTime1(2) = 31 'May
MonthTime1(3) = 30 'June
MonthTime1(4) = 31 'March
MonthTime1(5) = IsLeapYear() ' February
Case 5 'May
MonthTime1(1) = 31 'May
MonthTime1(2) = 30 'June
MonthTime1(3) = 31 'July
MonthTime1(4) = 30 'April
MonthTime1(5) = 31 'March
Case 6 'June
MonthTime1(1) = 30 'June
MonthTime1(2) = 31 'July
MonthTime1(3) = 31 'August
MonthTime1(4) = 31 'May
MonthTime1(5) = 30 'April
Case 7 'July
MonthTime1(1) = 31 'July
MonthTime1(2) = 31 'August
MonthTime1(3) = 30 'September
MonthTime1(4) = 30 'June
MonthTime1(5) = 31 'May
Case 8 'August
MonthTime1(1) = 30 'August
MonthTime1(2) = 31 'September
MonthTime1(3) = 31 'October
MonthTime1(4) = 31 'July
MonthTime1(5) = 30 'June
Case 9 'September
MonthTime1(1) = 31 'September
MonthTime1(2) = 31 'October
MonthTime1(3) = 30 'November
MonthTime1(4) = 30 'August
MonthTime1(5) = 31 'July
Case 10 'October
MonthTime1(1) = 31 'October
MonthTime1(2) = 30 'November
MonthTime1(3) = 31 'December
MonthTime1(4) = 31 'September
MonthTime1(5) = 30 'August
Case 11 'November
MonthTime1(1) = 30 'November
MonthTime1(2) = 31 'December
MonthTime1(3) = 31 'January
MonthTime1(4) = 31 'October
MonthTime1(5) = 31 'September
Case 12 'December
MonthTime1(1) = 31 'December
MonthTime1(2) = 31 'January
MonthTime1(3) = IsLeapYear() 'February
MonthTime1(4) = 30 'November
MonthTime1(5) = 31 'October
End Select
MonthTime = MonthTime1
End Function
Public Function ElapsedTimeString(dateTimeStart As Date) _
As String
'*************************************************************
' Function ElapsedTimeString(dateTimeStart As Date,
' dateTimeEnd As Date) As String
' Returns the time elapsed between a starting Date/Time and
' an ending Date/Time formatted as a string that looks like
' this:
' "20 hours, 30 minutes".
'*************************************************************
Dim interval As Double, str As String, days As Variant
Dim hours As String, minutes As String, seconds As String
If IsNull(dateTimeStart) = True Then Exit Function
interval = Now() - dateTimeStart
hours = Format(interval, "h")
minutes = Format(interval, "n")
' Hours part of the string
str = str & IIf(hours = "0", "", _
IIf(hours = "1", hours & " hour", hours & " hours"))
str = str & IIf(hours = "0", "", _
IIf(minutes <> "0", ", ", " "))
' Minutes part of the string
str = str & IIf(minutes = "0", "", _
IIf(minutes = "1", minutes & " minute", _
minutes & " minutes"))
ElapsedTimeString = IIf(str = "", "0", str)
End Function
