Elegant code for TimeSince()

[Ellis Dee]

I'm writing what I thought was going to be a simple function to describe a time in the past, but it's quickly becoming way more complex than I expected.

The purpose is for a personal backup routine, so I don't technically "need" this, but it's become a puzzle I'm fascinated by. I'm hoping there's some clever tricks with DateSerial() or whatever to tighten this code up from being a total mess.

The goal is to be able to go back an arbitrary amount of time, up to years (but not decades) and always return a string with the two most significant values. Sample outputs would be:

37 seconds ago
13 minutes, 5 seconds ago
1 hour, 12 minutes ago
3 days, 4 hours ago
2 weeks, 1 day ago
6 months, 2 weeks ago
1 year, 2 months ago

I start by DateDiff()ing the difference in seconds. A long can go up to 68 years worth of seconds, so that's plenty. I also set up a helper function to handle pluralization because that's how I roll:

Private Function Plural(plngNumber As Long, pstrSingular As String) As String
    If plngNumber = 1 Then Plural = "1 " & pstrSingular Else Plural = plngNumber & " " & pstrSingular & "s"
End Function

Things started getting weird when I got to "x months, y weeks." Here's what I have so far:

' Arbitrary value for "blank" date
Public Const NullDate As Date = #1/27/1991# ' WIDE RIGHT!!!!!
 
Public Function TimeSince(pdtmDate As Date) As String
    Dim lngYears As Long
    Dim lngMonths As Long
    Dim lngWeeks As Long
    Dim lngDays As Long
    Dim lngHours As Long
    Dim lngMinutes As Long
    Dim lngSeconds As Long
    Dim strReturn As String
    
    Do While pdtmDate <> NullDate 
        ' Seconds
        lngSeconds = DateDiff("s", pdtmDate, Now())
        If lngSeconds <= 60 Then
            strReturn = Plural(lngSeconds, "second")
            Exit Do
        End If
        ' Minutes, Seconds
        lngMinutes = lngSeconds \ 60
        lngSeconds = lngSeconds - lngMinutes * 60
        If lngMinutes <= 60 Then
            strReturn = Plural(lngMinutes, "minute") & ", " & Plural(lngSeconds, "second")
            Exit Do
        End If
        ' Hours, Minutes
        lngHours = lngMinutes \ 60
        lngMinutes = lngMinutes - lngHours * 60
        If lngHours <= 24 Then
            strReturn = Plural(lngHours, "hour") & ", " & Plural(lngMinutes, "minute")
            Exit Do
        End If
        ' Days, Hours
        lngDays = lngHours \ 24
        lngHours = lngHours - lngDays * 24
        If lngDays <= 7 Then
            strReturn = Plural(lngDays, "day") & ", " & Plural(lngHours, "hour")
            Exit Do
        End If
        ' Weeks, Days
        If pdtmDate >= DateAdd("m", -1, Now()) Then
            lngWeeks = lngDays \ 7
            lngDays = lngDays - lngWeeks * 7
            strReturn = Plural(lngWeeks, "week") & ", " & Plural(lngDays, "day")
            Exit Do
        End If
        ' Months, Weeks
        ' ???
        ' Years, Months
        ' ???
        Exit Do
    Loop
    If Len(strReturn) Then strReturn = strReturn & " ago" Else strReturn = "Never"
    TimeSince = strReturn
End Function