Results 1 to 10 of 11

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

Threaded View

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

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

    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).

    Code:
    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.
    Last edited by Rick Rothstein; 12-29-2018 at 10:24 PM.

Similar Threads

  1. Number into words (Rupees)
    By Admin in forum Download Center
    Replies: 2
    Last Post: 06-14-2014, 12:05 AM
  2. Number to Words (Rupees)
    By vishwajeet_chakravorty in forum Excel Help
    Replies: 8
    Last Post: 02-24-2014, 09:26 PM
  3. Excel Number Format: Indian Style Comma Separation
    By Rick Rothstein in forum Rick Rothstein's Corner
    Replies: 6
    Last Post: 09-18-2013, 11:38 AM
  4. Follow-up to "Excel Number Format: Indian Style Comma Separation"
    By Rick Rothstein in forum Rick Rothstein's Corner
    Replies: 2
    Last Post: 04-14-2012, 10:46 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
  •