Spell a Date out in Words

[Rick Rothstein]

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.


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

[Haseeb A]

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

[Rick Rothstein]

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? :)


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 (http://support.microsoft.com/kb/214326)


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.

[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 ***


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

[Rick Rothstein]

There was a bug in my last posted code which 'littleiitin' discovered. Here is the corrected 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