Yet Another Number-To-Words Function (Sorry, US Style Only)

[Rick Rothstein]

You are probably wondering, "Why on earth is he posting another number-to-words function?" Well, I think mine is slightly different than those you have seen before. For one thing, my function can handle very large numbers... a fraction less than a quintillion. That is a number with 18 digits in front of the decimal point! For another thing, you can post your output in any one of four different way. Anyway, follow these instructions and try it out... if you don't like it, you can always delete it. And, of course, this function can be called from your other VB code or it can be used as a UDF (user defined function) in worksheet formulas.

Go into the VB Editor (Alt+F11) and add a Module to the Workbook (Insert/Module from the VBA menu) and then paste in all of the code appearing below into the Module's code window. You can call the function from your work sheet like this =NumberAsText(A1) where A1 is assumed to hold the number you want to convert. There is an Optional argument you can use to format the results to your liking. Here are some examples to show the options available...

A1: 123.45

In B1:
--------------
=NumberAsText(A1) ==> One Hundred Twenty Three Point Four Five
=NumberAsText(A1,"And") ==> One Hundred and Twenty Three Point Four Five
=NumberAsText(A1,"Check") ==> One Hundred Twenty Three and 45/100
=NumberAsText(A1,"Dollar") ==> One Hundred Twenty Three Dollars and Forty Five Cents
=NumberAsText(A1,"CheckDollar") ==> One Hundred Twenty Three Dollars and 45/100

To summarize, using "And" adds the word "and" in front of the tens/units text; using "Check" formats any decimal values as would be written on a check; using "Dollar" adds the words "Dollars" and "Cents" in their appropriate positions; and using "CheckDollar" adds the word "Dollars" but leaves the decimal portions as a fraction of a dollar.

The code is laid out in a reasonably straight forward manner, so if Dollars/Cents is not you native currency designation, you might be able to modify the program to fit your own units. In addition to the above, for all modes, the Plus and Minus sign can be used and will be reported back as a word; commas may be used to separate the numbers to the left of the decimal point but they will not be reported back by the routine and are permitted for the users convenience (however, if commas are used, they must be placed in their correct positions). If you specify an option that includes words, those words are properly pluralize (meaning 1 reports as One Dollar and not One Dollars). And, as I said earlier, this function will work with a whole number part up to one less than a quintillion (you can have as many decimal places after the decimal point as desired), but remember to pass in very large numbers as Text... otherwise they will end up being converted to Doubles (which will destroy the conversion).

Private sNumberText() As String

Public Function NumberAsText(NumberIn As Variant, Optional _
                AND_or_CHECK_or_DOLLAR_or_CHECKDOLLAR As String) As String
   Dim cnt As Long
   Dim DecimalPoint As Long
   Dim CardinalNumber As Long
   Dim CommaAdjuster As Long
   Dim TestValue As Long
   Dim CurrValue As Currency
   Dim CentsString As String
   Dim NumberSign As String
   Dim WholePart As String
   Dim BigWholePart As String
   Dim DecimalPart As String
   Dim tmp As String
   Dim sStyle As String
   Dim bUseAnd As Boolean
   Dim bUseCheck As Boolean
   Dim bUseDollars As Boolean
   Dim bUseCheckDollar As Boolean
  '----------------------------------------
  '  Begin setting conditions for formatting
  '----------------------------------------
   sStyle = LCase(AND_or_CHECK_or_DOLLAR_or_CHECKDOLLAR)
   bUseAnd = sStyle = "and"
   bUseDollars = sStyle = "dollar"
   bUseCheck = (sStyle = "check") Or (sStyle = "dollar")
   bUseCheckDollar = sStyle = "checkdollar"
  '----------------------------------------
  '  Check/create array. If this is the first
  '  time using this routine, create the text
  '  strings that will be used.
  '----------------------------------------
   If Not IsBounded(sNumberText) Then
      Call BuildArray(sNumberText)
   End If
  '----------------------------------------
  '  Begin validating the number, and breaking
  '  into constituent parts
  '----------------------------------------
   NumberIn = Trim$(NumberIn)
   If Not IsNumeric(NumberIn) Then
      NumberAsText = "Error - Number improperly formed"
      Exit Function
   Else
      DecimalPoint = InStr(NumberIn, ".")
      If DecimalPoint > 0 Then
         DecimalPart = Mid$(NumberIn, DecimalPoint + 1)
         WholePart = Left$(NumberIn, DecimalPoint - 1)
      Else
         DecimalPoint = Len(NumberIn) + 1
         WholePart = NumberIn
      End If
      If InStr(NumberIn, ",,") Or _
         InStr(NumberIn, ",.") Or _
         InStr(NumberIn, ".,") Or _
         InStr(DecimalPart, ",") Then
         NumberAsText = "Error - Improper use of commas"
         Exit Function
      ElseIf InStr(NumberIn, ",") Then
         CommaAdjuster = 0
         WholePart = ""
         For cnt = DecimalPoint - 1 To 1 Step -1
            If Not Mid$(NumberIn, cnt, 1) Like "[,]" Then
               WholePart = Mid$(NumberIn, cnt, 1) & WholePart
            Else
               CommaAdjuster = CommaAdjuster + 1
               If (DecimalPoint - cnt - CommaAdjuster) Mod 3 Then
                  NumberAsText = "Error - Improper use of commas"
                  Exit Function
               End If
            End If
         Next
      End If
   End If
   If Left$(WholePart, 1) Like "[+-]" Then
      NumberSign = IIf(Left$(WholePart, 1) = "-", "Minus ", "Plus ")
      WholePart = Mid$(WholePart, 2)
   End If
  '----------------------------------------
  '  Begin code to assure decimal portion of
  '  check value is not inadvertently rounded
  '----------------------------------------
   If bUseCheck = True Then
      CurrValue = CCur(Val("." & DecimalPart))
      DecimalPart = Mid$(Format$(CurrValue, "0.00"), 3, 2)
      If CurrValue >= 0.995 Then
         If WholePart = String$(Len(WholePart), "9") Then
            WholePart = "1" & String$(Len(WholePart), "0")
         Else
            For cnt = Len(WholePart) To 1 Step -1
              If Mid$(WholePart, cnt, 1) = "9" Then
                 Mid$(WholePart, cnt, 1) = "0"
              Else
                 Mid$(WholePart, cnt, 1) = _
                            CStr(Val(Mid$(WholePart, cnt, 1)) + 1)
                 Exit For
              End If
            Next
         End If
      End If
   End If
  '----------------------------------------
  '  Final prep step - this assures number
  '  within range of formatting code below
  '----------------------------------------
   If Len(WholePart) > 9 Then
      BigWholePart = Left$(WholePart, Len(WholePart) - 9)
      WholePart = Right$(WholePart, 9)
   End If
   If Len(BigWholePart) > 9 Then
      NumberAsText = "Error - Number too large"
      Exit Function
   ElseIf Not WholePart Like String$(Len(WholePart), "#") Or _
         (Not BigWholePart Like String$(Len(BigWholePart), "#") _
          And Len(BigWholePart) > 0) Then
      NumberAsText = "Error - Number improperly formed"
      Exit Function
   End If
  '----------------------------------------
  '  Begin creating the output string
  '----------------------------------------
  '  Very Large values
   TestValue = Val(BigWholePart)
   If TestValue > 999999 Then
      CardinalNumber = TestValue \ 1000000
      tmp = HundredsTensUnits(CardinalNumber) & "Quadrillion "
      TestValue = TestValue - (CardinalNumber * 1000000)
   End If
   If TestValue > 999 Then
     CardinalNumber = TestValue \ 1000
     tmp = tmp & HundredsTensUnits(CardinalNumber) & "Trillion "
     TestValue = TestValue - (CardinalNumber * 1000)
   End If
   If TestValue > 0 Then
      tmp = tmp & HundredsTensUnits(TestValue) & "Billion "
   End If
  '  Lesser values
   TestValue = Val(WholePart)
   If TestValue = 0 And BigWholePart = "" Then tmp = "Zero "
   If TestValue > 999999 Then
      CardinalNumber = TestValue \ 1000000
      tmp = tmp & HundredsTensUnits(CardinalNumber) & "Million "
      TestValue = TestValue - (CardinalNumber * 1000000)
   End If
   If TestValue > 999 Then
      CardinalNumber = TestValue \ 1000
      tmp = tmp & HundredsTensUnits(CardinalNumber) & "Thousand "
      TestValue = TestValue - (CardinalNumber * 1000)
   End If
   If TestValue > 0 Then
      If Val(WholePart) < 99 And BigWholePart = "" Then bUseAnd = False
      tmp = tmp & HundredsTensUnits(TestValue, bUseAnd)
   End If
  '  If in dollar mode, assure the text is the correct plurality
   If bUseDollars = True Then
      CentsString = HundredsTensUnits(DecimalPart)
      If tmp = "One " Then
         tmp = tmp & "Dollar"
      Else
         tmp = tmp & "Dollars"
      End If
      If Len(CentsString) > 0 Then
         tmp = tmp & " and " & CentsString
         If CentsString = "One " Then
            tmp = tmp & "Cent"
         Else
            tmp = tmp & "Cents"
         End If
      End If
   ElseIf bUseCheck = True Then
      tmp = tmp & "and " & Left$(DecimalPart & "00", 2)
      tmp = tmp & "/100"
   ElseIf bUseCheckDollar = True Then
      If tmp = "One " Then
         tmp = tmp & "Dollar"
      Else
         tmp = tmp & "Dollars"
      End If
      tmp = tmp & " and " & Left$(DecimalPart & "00", 2)
      tmp = tmp & "/100"
   Else
      If Len(DecimalPart) > 0 Then
        tmp = tmp & "Point"
        For cnt = 1 To Len(DecimalPart)
          tmp = tmp & " " & sNumberText(Mid$(DecimalPart, cnt, 1))
        Next
      End If
   End If
  '  Done!
   NumberAsText = NumberSign & tmp
End Function

Private Sub BuildArray(sNumberText() As String)
   ReDim sNumberText(0 To 27) As String
   sNumberText(0) = "Zero"
   sNumberText(1) = "One"
   sNumberText(2) = "Two"
   sNumberText(3) = "Three"
   sNumberText(4) = "Four"
   sNumberText(5) = "Five"
   sNumberText(6) = "Six"
   sNumberText(7) = "Seven"
   sNumberText(8) = "Eight"
   sNumberText(9) = "Nine"
   sNumberText(10) = "Ten"
   sNumberText(11) = "Eleven"
   sNumberText(12) = "Twelve"
   sNumberText(13) = "Thirteen"
   sNumberText(14) = "Fourteen"
   sNumberText(15) = "Fifteen"
   sNumberText(16) = "Sixteen"
   sNumberText(17) = "Seventeen"
   sNumberText(18) = "Eighteen"
   sNumberText(19) = "Nineteen"
   sNumberText(20) = "Twenty"
   sNumberText(21) = "Thirty"
   sNumberText(22) = "Forty"
   sNumberText(23) = "Fifty"
   sNumberText(24) = "Sixty"
   sNumberText(25) = "Seventy"
   sNumberText(26) = "Eighty"
   sNumberText(27) = "Ninety"
End Sub

Private Function IsBounded(vntArray As Variant) As Boolean
   On Error Resume Next
   IsBounded = IsNumeric(UBound(vntArray))
End Function

Private Function HundredsTensUnits(ByVal TestValue As Integer, _
                              Optional bUseAnd As Boolean) As String
   Dim CardinalNumber As Integer
   If TestValue > 99 Then
      CardinalNumber = TestValue \ 100
      HundredsTensUnits = sNumberText(CardinalNumber) & " Hundred "
      TestValue = TestValue - (CardinalNumber * 100)
   End If
   If bUseAnd = True Then
      HundredsTensUnits = HundredsTensUnits & "and "
   End If
   If TestValue > 20 Then
      CardinalNumber = TestValue \ 10
      HundredsTensUnits = HundredsTensUnits & _
                          sNumberText(CardinalNumber + 18) & " "
      TestValue = TestValue - (CardinalNumber * 10)
   End If
   If TestValue > 0 Then
      HundredsTensUnits = HundredsTensUnits & _
                          sNumberText(TestValue) & " "
   End If
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 NumberAsText just like it was a built-in Excel function. For example,

=NumberAsText(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.