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:

1. Stored as a string
2. Stored as individual fields
3. Stored as a fractional unit (e.g., days)
4. 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:

• Pluralize()
• RegExReplace()
• Conc()

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