Displaying Human Readable Time Spans
Storing and displaying time spans in Microsoft Access is deceptively difficult.
I wrote an article describing four different approaches one could take:
- Stored as a string
- Stored as individual fields
- Stored as a fractional unit (e.g., days)
- Stored as a whole number unit (e.g., seconds)
Each approach has advantages and disadvantages, but I already discussed all that in the article linked above. Today I want to write about implementation. More specifically, I want to talk about implementing the fourth approach above.
Here's where I'd like to thank former Access MVP Dale Fye for teeing things up nicely for us with his comment on LinkedIn:
Converting Seconds to Human Readable Time Spans
I wanted a solution where I could pass an arbitrary number of seconds to the function, and it would convert that number into a human readable time span.
My function, HumanizedSeconds(), follows a few basic rules:
- Display the time span in the largest units possible (e.g., 5 minutes instead of 300 seconds)
- Concatenate multiple units with commas
- Handle pluralization
- If days are divisible by 7, display as "weeks" (e.g., 4 weeks instead of 28 days)
- If days are not divisible by 7, show the raw day count (e.g., 30 days instead of 4 weeks, 2 days)
- "Days" and "weeks" never appear in the same output
- "Years" are assumed to be 365 days (leap days disregarded)
- "Months" never occur in output because their length varies (28 - 31 days)
Here is some sample usage:
Converting Multiple Time Units to Seconds
Obviously, you wouldn't be prompting your users to enter time spans in seconds.
Instead, you would use unbound text boxes to collect the various units of time: years, weeks, days, etc. Thus, we will need a companion function to convert these units into seconds for efficient storage. Here is what that function–cleverly named ConvertToSeconds()–looks like:
The Code
The HumanizedSeconds() function depends on many other functions I have written about in the past, including:
All of these dependencies are included in the sample code below for your convenience.
I'm also using my Python-inspired doc test comments (the ones that start with '>>>) to provide both usage examples and code verification.
ENJOY!
Option Compare Database
Option Explicit
'Constants for HumanizedSeconds and ConvertToSeconds functions:
Private Const SecondsPerMinute As Long = 60
Private Const SecondsPerHour As Long = SecondsPerMinute * 60
Private Const SecondsPerDay As Long = SecondsPerHour * 24
Private Const SecondsPerYear As Long = SecondsPerDay * 365
'>>> HumanizedSeconds(60)
' 1 minute
'>>> HumanizedSeconds(120)
' 2 minutes
'>>> HumanizedSeconds(60 * 60 * 3)
' 3 hours
'>>> HumanizedSeconds(60 * 60 * 24 * 5)
' 5 days
'>>> HumanizedSeconds(60 * 60 * 24 * 29)
' 29 days
'>>> HumanizedSeconds(60 * 60 * 24 * 365)
' 1 year
'>>> HumanizedSeconds(60 * 60 * 24 * 365 * 2)
' 2 years
'>>> HumanizedSeconds(60& * 60 * 24 * 365 * 4 + 60& * 60 * 24 * 14 + 60 * 60 * 3 + 60 * 7 + 33)
' 4 years, 2 weeks, 3 hours, 7 minutes, 33 seconds
'
'If "days" are evenly divisible by 7, they output as "weeks"
'>>> HumanizedSeconds(60 * 60 * 24 * 28)
' 4 weeks
'>>> HumanizedSeconds(60 * 60 * 24 * 28 + 60 * 60 * 19 + 60 * 3 + 22)
' 4 weeks, 19 hours, 3 minutes, 22 seconds
'
'Supports time spans up to 68 years (longer if LongLong used on 64-bit VBA)
'>>> HumanizedSeconds(2147483647)
' 68 years, 5 weeks, 3 hours, 14 minutes, 7 seconds
'
' ----------------------------------------------------------------
' Procedure : HumanizedSeconds
' Author : Mike Wolfe <mike@nolongerset.com>
' Date : 3/9/2022
' Source : https://nolongerset.com/displaying-time-spans/
' Purpose : Returns a human friendly description of the timeframe passed in seconds.
' Requires - StringFunctions.Pluralize() function
' Notes - "Years" are assumed to be exactly 365 days (leap days not considered)
' - "Months" never appear in output because their length varies (28 - 31 days)
' - "Weeks" only show if number of days is evenly divisible by 7
' - "Weeks" and "Days" never appear in the same output
' ----------------------------------------------------------------
Function HumanizedSeconds(Seconds As Long) As String
Dim Years As Long
Years = Seconds \ SecondsPerYear
Dim Days As Long
Days = (Seconds - (Years * SecondsPerYear)) \ SecondsPerDay
Dim Hours As Long
Hours = (Seconds _
- (Years * SecondsPerYear) _
- (Days * SecondsPerDay)) \ SecondsPerHour
Dim Minutes As Long
Minutes = (Seconds _
- (Years * SecondsPerYear) _
- (Days * SecondsPerDay) _
- (Hours * SecondsPerHour)) \ SecondsPerMinute
Dim Secs As Long
Secs = (Seconds _
- (Years * SecondsPerYear) _
- (Days * SecondsPerDay) _
- (Hours * SecondsPerHour) _
- (Minutes * SecondsPerMinute))
Dim Weeks As Long
If Days Mod 7 = 0 Then
Weeks = Days / 7
Days = 0
End If
Dim s As String
If Years > 0 Then s = Conc(s, Pluralize("# year[s]", Years))
If Weeks > 0 Then s = Conc(s, Pluralize("# week[s]", Weeks))
If Days > 0 Then s = Conc(s, Pluralize("# day[s]", Days))
If Hours > 0 Then s = Conc(s, Pluralize("# hour[s]", Hours))
If Minutes > 0 Then s = Conc(s, Pluralize("# minute[s]", Minutes))
If Secs > 0 Then s = Conc(s, Pluralize("# second[s]", Secs))
HumanizedSeconds = s
End Function
'>>> ConvertToSeconds( 0, 0, 0, 0, 0, 1)
' 1
'>>> ConvertToSeconds( 0, 0, 0, 0, 1, 0)
' 60
'>>> ConvertToSeconds( 0, 0, 0, 1, 0, 0)
' 3600
'>>> ConvertToSeconds( 0, 0, 1, 0, 0, 0)
' 86400
'>>> ConvertToSeconds( 0, 1, 0, 0, 0, 0)
' 604800
'>>> ConvertToSeconds( 1, 0, 0, 0, 0, 0)
' 31536000
'>>> ConvertToSeconds(10, 0, 0, 0, 0, 0)
' 315360000
'
' 2147483647 is the maximum value for the Long data type:
'>>> ConvertToSeconds(68, 5, 0, 3, 14, 7)
' 2147483647
' ----------------------------------------------------------------
' Procedure : ConvertToSeconds
' Author : Mike Wolfe <mike@nolongerset.com>
' Date : 3/9/2022
' Source : https://nolongerset.com/displaying-time-spans/
' Purpose : Converts from a variety of time units into seconds.
' Notes - This is a companion function to the HumanizedSeconds() function.
' ----------------------------------------------------------------
Function ConvertToSeconds(Years As Long, Weeks As Long, _
Days As Long, Hours As Long, _
Minutes As Long, Seconds As Long) As Long
Const SecondsPerWeek As Long = SecondsPerDay * 7
ConvertToSeconds = Years * SecondsPerYear _
+ Weeks * SecondsPerWeek _
+ Days * SecondsPerDay _
+ Hours * SecondsPerHour _
+ Minutes * SecondsPerMinute _
+ Seconds
End Function
'----------------------------'
' '
' Additional dependencies '
' '
'----------------------------'
'---------------------------------------------------------------------------------------
' Procedure : Pluralize
' Author : Mike Wolfe <mike@nolongerset.com>
' Source : https://nolongerset.com/the-pluralize-function/
' Purpose : Formats a phrase to make verbs agree in number.
' Notes : To substitute the absolute value of the number for numbers that can be
' positive or negative, use a custom number format that includes
' both positive and negative formats; e.g., "#;#".
'---------------------------------------------------------------------------------------
'
Function Pluralize(Text As String, Num As Variant, _
Optional NumToken As String = "#", _
Optional NumFormat As String = "")
Const OpeningBracket As String = "\["
Const ClosingBracket As String = "\]"
Const OpeningBrace As String = "\{"
Const ClosingBrace As String = "\}"
Const DividingSlash As String = "/"
Const CharGroup As String = "([^\]]*)" 'Group of 0 or more characters not equal to closing bracket
Const BraceGroup As String = "([^\/\}]*)" 'Group of 0 or more characters not equal to closing brace or dividing slash
Dim IsPlural As Boolean, IsNegative As Boolean
If IsNumeric(Num) Then
IsPlural = (Abs(Num) <> 1)
IsNegative = (Num < 0)
End If
Dim Msg As String, Pattern As String
Msg = Text
'Replace the number token with the actual number
Msg = Replace(Msg, NumToken, Format(Num, NumFormat))
'Replace [y/ies] style references
Pattern = OpeningBracket & CharGroup & DividingSlash & CharGroup & ClosingBracket
Msg = RegExReplace(Pattern, Msg, "$" & IIf(IsPlural, 2, 1))
'Replace [s] style references
Pattern = OpeningBracket & CharGroup & ClosingBracket
Msg = RegExReplace(Pattern, Msg, IIf(IsPlural, "$1", ""))
'Replace {gain/loss} style references
Pattern = OpeningBrace & BraceGroup & DividingSlash & BraceGroup & ClosingBrace
Msg = RegExReplace(Pattern, Msg, "$" & IIf(IsNegative, 2, 1))
Pluralize = Msg
End Function
'---------------------------------------------------------------------------------------
' Procedure : RegExReplace
' Author : Mike Wolfe <mike@nolongerset.com>
' Source : https://nolongerset.com/now-you-have-two-problems/
' Purpose : Attempts to replace text in the TextToSearch with text and back references
' from the ReplacePattern for any matches found using SearchPattern.
' Notes - If no matches are found, TextToSearch is returned unaltered. To get
' specific info from a string, use RegExExtract instead.
'---------------------------------------------------------------------------------------
'
Function RegExReplace(SearchPattern As String, TextToSearch As String, ReplacePattern As String, _
Optional GlobalReplace As Boolean = True, _
Optional IgnoreCase As Boolean = False, _
Optional MultiLine As Boolean = False) As String
Dim RE As Object
Set RE = CreateObject("vbscript.regexp")
With RE
.MultiLine = MultiLine
.Global = GlobalReplace
.IgnoreCase = IgnoreCase
.Pattern = SearchPattern
End With
RegExReplace = RE.Replace(TextToSearch, ReplacePattern)
End Function
'---------------------------------------------------------------------------------------
' Procedure : Conc
' Author : Mike Wolfe <mike@nolongerset.com>
' Source : https://nolongerset.com/come-together/
' Purpose : Concatenates two strings
' Notes : Eliminates the need to strip off the leading/trailing delimiter when
' building a string list
'---------------------------------------------------------------------------------------
'
Function Conc(StartText As Variant, NextVal As Variant, _
Optional Delimiter As String = ", ") As String
If Len(Nz(StartText)) = 0 Then
Conc = Nz(NextVal)
ElseIf Len(Nz(NextVal)) = 0 Then
Conc = StartText
Else
Conc = StartText & Delimiter & NextVal
End If
End Function
Image by Stefan Keller from Pixabay