Results 1 to 5 of 5

Thread: Spell a Date out in Words

  1. #1
    Forum Guru Rick Rothstein's Avatar
    Join Date
    Feb 2012
    Posts
    662
    Rep Power
    13

    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

  2. #2
    Junior Member Haseeb A's Avatar
    Join Date
    Apr 2011
    Posts
    21
    Rep Power
    0
    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
    Attached Files Attached Files

  3. #3
    Forum Guru Rick Rothstein's Avatar
    Join Date
    Feb 2012
    Posts
    662
    Rep Power
    13
    Quote Originally Posted by Haseeb Avarakkan View Post
    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 View Post
    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 View Post
    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.
    Last edited by Rick Rothstein; 02-25-2012 at 01:47 PM.

  4. #4
    Forum Guru Rick Rothstein's Avatar
    Join Date
    Feb 2012
    Posts
    662
    Rep Power
    13
    Quote Originally Posted by Rick Rothstein View Post
    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
    Last edited by Rick Rothstein; 02-25-2012 at 08:56 PM.

  5. #5
    Forum Guru Rick Rothstein's Avatar
    Join Date
    Feb 2012
    Posts
    662
    Rep Power
    13
    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

Similar Threads

  1. Number to Words (Rupees)
    By vishwajeet_chakravorty in forum Excel Help
    Replies: 8
    Last Post: 02-24-2014, 09:26 PM
  2. Replies: 5
    Last Post: 06-15-2013, 12:40 PM
  3. Replace Incorrect Date In Cell To Another Valid Date
    By DARSHANKmandya in forum Excel and VBA Tips and Tricks
    Replies: 2
    Last Post: 03-21-2013, 09:27 PM
  4. Spell a Date out in Words
    By Rick Rothstein in forum Rick Rothstein's Corner
    Replies: 6
    Last Post: 04-08-2012, 12:19 PM
  5. Number to Words (Rupees)
    By sa.1985 in forum Excel Help
    Replies: 2
    Last Post: 12-16-2011, 08:57 PM

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •