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

