Spell a Date out in Words

**Rick Rothstein** · 02-22-2012, 11:13 PM

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")
  If Len(DateIn) = 0 Then Exit Function
  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

HOW TO INSTALL UDFs
------------------------------------
If you are new to UDFs, they are easy to install and use. To install it, simply press ALT+F11 to go into the VB editor and, once there, click Insert/Module on its menu bar, then copy/paste the above code into the code window that just opened up. That's it.... you are done. You can now use DateToWords just like it was a built-in Excel function. For example,

=DateToWords(A1)

If you are using XL2007 or above, make sure you save your file as an "Excel Macro-Enabled Workbook (*.xlsm) and answer the "do you want to enable macros" question as "yes" or "OK" (depending on the button label for your version of Excel) the next time you open your workbook.

**littleiitin** · 02-25-2012, 07:31 PM

**Rick Rothstein** · 02-25-2012, 08:39 PM

Originally Posted by littleiitin

Very good function, however I think it is giving some irregular result....

like;
11/17/1980 Eighteenth of November, One Thousand Nine Hundred Eighty-

Thanks for catching that. I have corrected the original code (in Message #1).

**stanleydgromjr** · 03-02-2012, 03:26 AM

Rick Rothstein,

Nicely done. One for my archives.

You may want to make this available on MrExcel, ExcelForum, and Ozgrid.

**Rick Rothstein** · 03-06-2012, 12:54 AM

Thanks Stanley, I am honored you consider my code worthy of archiving. As for posting it to other forums... I am a little reluctant to do that when my code is not directly addressing a question that has been asked. I always think, "What if everyone decided to do that?" and conclude it would interfere with the smooth running of that forum, which I am unwilling to be a party to. The folks here at excelfox.com have been overly generous in giving me my own mini-forum within their main forum, so what I have started to do is include the link to it in responses that posted elsewhere. That will hopefully lead people back to (all) my code snippets and, more importantly, to excelfox.com in general.

**Admin** · 04-08-2012, 12:10 PM

Hi Rick,

The function gives Thirty-first of December, One Thousand Eight Hundred Ninety-Nine for a blank range.

It seems a small fix in the code.

**Rick Rothstein** · 04-08-2012, 12:19 PM

Originally Posted by Admin

The function gives Thirty-first of December, One Thousand Eight Hundred Ninety-Nine for a blank range.

Hmm, someone calling the function with the argument being the empty string just never occurred to me... thanks for catching that. I have corrected my original code (just in case new readers of this thread stop at the first message), but I am including the code here for anyone following this thread so they will be alerted to the change in 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 Len(DateIn) = 0 Then Exit Function
  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