Spell a Date out in Words

Did you ever need to spell a date out in words? This kind of date text is normally used on legal documents and checks but, of course, other applications are possible. For example, 2/22/2012 would be...

Twenty-second of February, Two Thousand Twelve

Below is a function that will do that (it can be called from other code or used as a UDF, user defined function, directly on a worksheet). If you want to change the way the text is put together, just rearrange/modify the last line of code.

Code:

---

Function DateToWords(ByVal DateIn As Variant) As String
  Dim Yrs As String, Hundreds As String, Decades As String
  Dim Tens As Variant, Ordinal As Variant, Cardinal As Variant
  Ordinal = Array("First", "Second", "Third", "Fourth", "Fifth", "Sixth", "Seventh", "Eighth", "Nineth", _
                  "Tenth", "Eleventh", "Twelfth", "Thirteenth", "Fourteenth", "Fifteenth", "Sixteenth", _
                  "Seventeenth", "Eighteenth", "Nineteenth", "Twentieth", "Twenty-first", "Twenty-second", _
                  "Twenty-third", "Twenty-fourth", "Twenty-fifth", "Twenty-sixth", "Twenty-seventh", _
                  "Twenty-eighth", "Twenty-nineth", "Thirtieth", "Thirty-first")
  Cardinal = Array("", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine", "Ten", "Eleven", _
                  "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen")
  Tens = Array("Twenty", "Thirty", "Forty", "Fifty", "Sixty", "Seventy", "Eighty", "Ninety")
  DateIn = CDate(DateIn)
  Yrs = CStr(Year(DateIn))
  Decades = Mid$(Yrs, 3)
  If CInt(Decades) < 20 Then
    Decades = Cardinal(CInt(Decades))
  Else
    Decades = Tens(CInt(Left$(Decades, 1)) - 2) & "-" & Cardinal(CInt(Right$(Decades, 1)))
  End If
  Hundreds = Mid$(Yrs, 2, 1)
  If CInt(Hundreds) Then
    Hundreds = Cardinal(CInt(Hundreds)) & " Hundred "
  Else
    Hundreds = ""
  End If
  DateToWords = Ordinal(Day(DateIn) - 1) & " of " & Format$(DateIn, "mmmm") & ", " & _
                Cardinal(CInt(Left$(Yrs, 1))) & " Thousand " & Hundreds & Decades
End Function

---

Nice one Rick as usual :)

A minor bug, for the period 1/1/1900 - 2/29/1900 shows a day prior.

eg:

1/1/1900 & 2/29/1900, shows "Thirty-first of December, One Thousand Eight Hundred Ninety-Nine" & "Twenty-eighth of February, One Thousand Nine Hundred" respectively.

Based on your logic, I think we could also use it by native formulas, with help of 2 lookup tables.


Regards,
Haseeb A

Quote:

---

Originally Posted by Haseeb Avarakkan

Nice one Rick as usual :)

---

Thank you, although I haven't really posted in this forum enough to have an "as usual" yet, have I? :)

Quote:

---

Originally Posted by Haseeb Avarakkan

A minor bug, for the period 1/1/1900 - 2/29/1900 shows a day prior.

eg:

1/1/1900 & 2/29/1900, shows "Thirty-first of December, One Thousand Eight Hundred Ninety-Nine" & "Twenty-eighth of February, One Thousand Nine Hundred" respectively.

---

Actually, there is no bug in my code (if you call the function from within other VB code, you will see it works correctly). There is a bug at work here though, but it is in Excel, not my code. Excel thinks that the year 1900 was a leap year meaning Excel thinks there was a February 29, 1900 when in reality there was no such date, my code (which does know 1900 was not a leap year) ends up reporting a day earlier for January and February 1900. Given this problem exists only for a set of dates that next to nobody will ever seek to display as words, I am not sure it is worth trying to fix... I think about trying to fix it though (not as straightforward a task as it might seem). Anyway, see here for the reason behind this Excel bug...

Excel 2000 incorrectly assumes that the year 1900 is a leap year

Quote:

---

Originally Posted by Haseeb Avarakkan

Based on your logic, I think we could also use it by native formulas, with help of 2 lookup tables.

---

That seems to work... nicely done! My preference is still for the UDF... less overhead in Excel "real estate" (meaning it is easily reusable in multiple workbooks) plus it can be called by other VB code where it can cover dates earlier than 1/1/1900 if desired.

Quote:

---

Originally Posted by Rick Rothstein

Actually, there is no bug in my code (if you call the function from within other VB code, you will see it works correctly). There is a bug at work here though, but it is in Excel, not my code. Excel thinks that the year 1900 was a leap year meaning Excel thinks there was a February 29, 1900 when in reality there was no such date was a real date, my code (which does know 1900 was not a leap year) ends up reporting a day earlier for January and February 1900. Given this problem exists only for a set of dates that next to nobody will ever seek to display as words, I am not sure it is worth trying to fix... I'll think about trying to fix it though (not as straightforward a task as it might seem).

---

Okay, I thought about it and the fix turned out not to be as bad as I thought it would be...

*** IGNORE THE CODE BELOW AND SEE NEXT MESSAGE ***

Code:

---

Function DateToWords(ByVal DateIn As Variant) As String
  Dim Yrs As String, Hundreds As String, Decades As String
  Dim Tens As Variant, Ordinal As Variant, Cardinal As Variant
  Ordinal = Array("First", "Second", "Third", "Fourth", "Fifth", "Sixth", "Seventh", "Eighth", "Nineth", _
                  "Tenth", "Eleventh", "Twelfth", "Thirteenth", "Fourteenth", "Fifteenth", "Sixteenth", _
                  "Seventeenth", "Eighteenth", "Nineteenth", "Twentieth", "Twenty-first", "Twenty-second", _
                  "Twenty-third", "Twenty-fourth", "Twenty-fifth", "Twenty-sixth", "Twenty-seventh", _
                  "Twenty-eighth", "Twenty-nineth", "Thirtieth", "Thirty-first")
  Cardinal = Array("", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine", "Ten", "Eleven", _
                  "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen")
  Tens = Array("Twenty", "Thirty", "Forty", "Fifty", "Sixty", "Seventy", "Eighty", "Ninety")
  If TypeOf Application.Caller Is Range Then
    '  The date serial number that Excel's worksheet thinks is for 2/29/1900
    '  is actually the date serial number that VB thinks is for 2/28/1900
    If Format([DateIn], "m/d/yyyy") = "2/28/1900" Then
      DateToWords = "Twenty-nineth of February, One Thousand Nine Hundred"
      Exit Function
    ElseIf CStr(DateIn) < CStr(DateSerial(1900, 3, 1)) Then
      If TypeOf Application.Caller Is Range Then DateIn = DateIn + 1
    End If
  End If
  DateIn = CDate(DateIn)
  Yrs = CStr(Year(DateIn))
  Decades = Mid$(Yrs, 3)
  If CInt(Decades) < 20 Then
    Decades = Cardinal(CInt(Decades))
  Else
    Decades = Tens(CInt(Left$(Decades, 1)) - 2) & "-" & Cardinal(CInt(Right$(Decades, 1)))
  End If
  Hundreds = Mid$(Yrs, 2, 1)
  If CInt(Hundreds) Then
    Hundreds = Cardinal(CInt(Hundreds)) & " Hundred "
  Else
    Hundreds = ""
  End If
  DateToWords = Ordinal(Day(DateIn) - 1) & " of " & Format$(DateIn, "mmmm") & ", " & _
                Cardinal(CInt(Left$(Yrs, 1))) & " Thousand " & Hundreds & Decades
End Function

---

There was a bug in my last posted code which 'littleiitin' discovered. Here is the corrected code...

Code:

---

Function DateToWords(ByVal DateIn As Variant) As String
  Dim Yrs As String, Hundreds As String, Decades As String
  Dim Tens As Variant, Ordinal As Variant, Cardinal As Variant
  Ordinal = Array("First", "Second", "Third", "Fourth", "Fifth", "Sixth", "Seventh", "Eighth", "Nineth", _
                  "Tenth", "Eleventh", "Twelfth", "Thirteenth", "Fourteenth", "Fifteenth", "Sixteenth", _
                  "Seventeenth", "Eighteenth", "Nineteenth", "Twentieth", "Twenty-first", "Twenty-second", _
                  "Twenty-third", "Twenty-fourth", "Twenty-fifth", "Twenty-sixth", "Twenty-seventh", _
                  "Twenty-eighth", "Twenty-nineth", "Thirtieth", "Thirty-first")
  Cardinal = Array("", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine", "Ten", "Eleven", _
                  "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen")
  Tens = Array("Twenty", "Thirty", "Forty", "Fifty", "Sixty", "Seventy", "Eighty", "Ninety")
  If TypeOf Application.Caller Is Range Then
    '  The date serial number that Excel's worksheet thinks is for 2/29/1900
    '  is actually the date serial number that VB thinks is for 2/28/1900
    If Format([DateIn], "m/d/yyyy") = "2/28/1900" Then
      DateToWords = "Twenty-nineth of February, One Thousand Nine Hundred"
      Exit Function
    ElseIf DateIn < DateSerial(1900, 3, 1) Then
      If TypeOf Application.Caller Is Range Then DateIn = DateIn + 1
    End If
  End If
  DateIn = CDate(DateIn)
  Yrs = CStr(Year(DateIn))
  Decades = Mid$(Yrs, 3)
  If CInt(Decades) < 20 Then
    Decades = Cardinal(CInt(Decades))
  Else
    Decades = Tens(CInt(Left$(Decades, 1)) - 2) & "-" & Cardinal(CInt(Right$(Decades, 1)))
    If Right(Decades, 1) = "-" Then Decades = Left(Decades, Len(Decades) - 1)
  End If
  Hundreds = Mid$(Yrs, 2, 1)
  If CInt(Hundreds) Then
    Hundreds = Cardinal(CInt(Hundreds)) & " Hundred "
  Else
    Hundreds = ""
  End If
  DateToWords = Ordinal(Day(DateIn) - 1) & " of " & Format$(DateIn, "mmmm") & ", " & _
                Cardinal(CInt(Left$(Yrs, 1))) & " Thousand " & Hundreds & Decades
End Function

---