[VBnet Helpers] Pure VB: Implementing a Number-To-Text Conversion Function


	Visual Basic Helper Routines Pure VB: Implementing a Number-To-Text Conversion Function

Posted:	Wednesday June 9, 1999
Updated:	Monday December 26, 2011

Applies to:	VB4-32, VB5, VB6, and VB3, VB4-16 with changes to non-supported methods
Developed with:	VB6, Windows NT4
OS restrictions:	None
Author:	Rick Rothstein

Related:	Pure VB: Converting Numbers to Fractions Pure VB: Converting Numbers to Roman Numerals (and Back) Pure VB: Implementing a Number-To-Text Conversion Function

Prerequisites

None.

An amazing number of Visual Basic developers have requested a routine to convert a numeric value into a textual representation. I've tried several methods posted on web sites and in newsgroups, but this method, originally posted in the Microsoft news forums, is perhaps one of the most encompassing I've seen.

Offering a variety of output options, the code as presented needs virtually no changes, yet is simple enough to understand should its present features not be exactly what you are looking for. The number to be converted to word text can be a numeric value or a string. As the illustration at the right shows, its output format is entirely up to the developer, initiated by passing an optional formatting keyword:

If the optional formatting keyword is omitted, a number such as 1234 will be returned as "One Thousand Two Hundred Thirty Four".
If the word "and" is passed, the word "and" will be inserted where normally expected; e.g., 1234 will become "One Thousand Two Hundred and Thirty Four".
Decimal numbers are supported with the decimal point indicated with the word "point". So the number 1.23 would be returned as "One Point Two Three".
If the word "check" is passed, the number returned will be written as on a check. Hence, 123.45 will report back as "One Hundred Twenty Three and 45/100". If there are more than two decimal places in the "check" mode, the decimal portion will be rounded to the nearest two decimal places.
If the word "dollar" is passed, the number returned will be written in full format. For example, 123.45 will report back as "One Hundred Twenty Three Dollars and Forty Five Cents". Once again, If there are more than two decimal places in the "dollar" mode, the decimal portion will be rounded to the nearest two decimal places.

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

Although I have made a couple of changes to the author's original routine, at the original authors request, permission is granted to use this routine in programs that you develop for non-commercial use only. If you wish to use this module for commercial use, please contact the programmer, Rick Rothstein. Rick retains all rights to the code. Modifications / enhancements by VBnet are provided free of charge.

BAS Module Code

None.

Form Code

To a form add one text box (Text1) and one label (Label1) and set the Index property for each control to 0 to create control arrays. The Load event takes care of creating and populating the demo form. Finally add a single command button (Command1) along with the following code:

Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce 
'               or publish this code on any web site,
'               online service, or distribute as source 
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'Module Name:   NumberAsText
'Programmer:    Frederick Rothstein
'Date Released: May 16, 1999
'Date Modified: August 20, 1999
'Copyright 1999 by Frederick N. Rothstein (All rights reserved)      
      

'array to hold the various textual
'representations of a number
Private sNumberText() As String

Private Sub Form_Load()

   Dim cnt As Long
   Dim nTop As Long
   Dim nWidth As Long
   
   For cnt = 0 To 24 '25 controls
   
      If cnt > 0 Then
         Load Text1(cnt)
         Load Label1(cnt)
      End If
      
      With Label1(cnt)
      
         .AutoSize = True
         .Move 200, (300 * cnt) + nTop
         
         Select Case cnt
            Case 0, 5, 10, 15, 20
               .Visible = False
               
            Case 1, 6, 11, 16, 21
               .Caption = "No Format"
               .Visible = True

            Case 2, 7, 12, 17, 22
               .Caption = "'And'"
               .Visible = True
            Case 3, 8, 13, 18, 23
               .Caption = "'Check'"
               .Visible = True
               
            Case 4, 9, 14, 19, 24
               .Caption = "'Dollar'"
               .Visible = True
               
         End Select
      End With  'Label1
                  
      nWidth = 1200
      
      With Text1(cnt)
      
         Select Case cnt
            Case 0
               .Text = "342.79"
               nTop = nTop + 200
            Case 5
               .Text = "1.14"
               nTop = nTop + 200
            Case 10
               .Text = "1.9950072"
               nTop = nTop + 200
            Case 15
               .Text = "+11432"
               nTop = nTop + 200
            Case 20
               .Text = "-81131"
               nTop = nTop + 200
            Case Else
               .Text = ""
               nWidth = 5000
         End Select

        .Move 1200, (300 * cnt) + nTop, nWidth
        .Visible = True
         
      End With  'Text1

   Next cnt
   
   With Command1
      .Caption = "Convert"
      .Move 1200, Text1(24).Top + Text1(24).Height + 200, 1500
   End With
   
  'preload sNumberText() with
  'strings representing the possible
  'textual representations of a number
   Call BuildArray(sNumberText)
   
End Sub
     
      
Private Sub Command1_Click()

   Dim value As String

   value = Text1(0).Text
   Text1(1).Text = NumberAsText(value, "")
   Text1(2).Text = NumberAsText(value, "and")
   Text1(3).Text = NumberAsText(value, "check")
   Text1(4).Text = NumberAsText(value, "dollar")

   value = Text1(5).Text
   Text1(6).Text = NumberAsText(value, "")
   Text1(7).Text = NumberAsText(value, "and")
   Text1(8).Text = NumberAsText(value, "check")
   Text1(9).Text = NumberAsText(value, "dollar")

   value = Text1(10).Text
   Text1(11).Text = NumberAsText(value, "")
   Text1(12).Text = NumberAsText(value, "and")
   Text1(13).Text = NumberAsText(value, "check")
   Text1(14).Text = NumberAsText(value, "dollar")

   value = Text1(15).Text
   Text1(16).Text = NumberAsText(value, "")
   Text1(17).Text = NumberAsText(value, "and")
   Text1(18).Text = NumberAsText(value, "check")
   Text1(19).Text = NumberAsText(value, "dollar")

   value = Text1(20).Text
   Text1(21).Text = NumberAsText(value, "")
   Text1(22).Text = NumberAsText(value, "and")
   Text1(23).Text = NumberAsText(value, "check")
   Text1(24).Text = NumberAsText(value, "dollar")
End Sub


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
 
  'note: the application in the IDE will stop
  'at this line when first run if the IDE error
  'mode is not set to "Break on Unhandled Errors"
  '(Tools/Options/General/Error Trapping)
   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


Private Function NumberAsText(NumberIn As Variant, _
                              Optional AND_or_CHECK_or_DOLLAR 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
   
   
  '----------------------------------------
  'Begin setting conditions for formatting
  '----------------------------------------
  
  'Determine whether to apply special formatting.
  'If nothing passed, return routine result
  'converted only into its numeric equivalents,
  'with no additional format text.
   sStyle = LCase(AND_or_CHECK_or_DOLLAR)

  'User passed "AND": "and" will be added 
  'between hundredths and tens of dollars,
  'ie "Three Hundred and Forty Two"
   bUseAnd = sStyle = "and"
   
  'User passed "DOLLAR": "dollar(s)" and "cents"
  'appended to string,
  'ie "Three Hundred and Forty Two Dollars"
   bUseDollars = sStyle = "dollar"
   
  'User passed "CHECK" *or* "DOLLAR"
  'If "check", cent amount returned as a fraction /100
  'i.e. "Three Hundred Forty Two and 00/100"
  'If "dollar" was passed, "dollar(s)" and "cents"
  'appended instead.
   bUseCheck = (sStyle = "check") Or (sStyle = "dollar")
    
    
  '----------------------------------------
  '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
  '----------------------------------------
  
  'prepare to check for valid value in
   NumberIn = Trim$(NumberIn)
   
   If Not IsNumeric(NumberIn) Then

     'invalid entry - abort
      NumberAsText = "Error - Number improperly formed"
      Exit Function

   Else

     'decimal check
      DecimalPoint = InStr(NumberIn, ".")

      If DecimalPoint > 0 Then

        'split the fractional and primary numbers
         DecimalPart = Mid$(NumberIn, DecimalPoint + 1)
         WholePart = Left$(NumberIn, DecimalPoint - 1)

      Else
      
        'assume the decimal is the last char
         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 'If
            End If  'If Not
         Next  'For cnt
      End If  'If InStr
   End If  'If Not

    
   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  'If WholePart
      End If  'If CurrValue
   End If  'If bUseCheck
    
  '----------------------------------------
  '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"
    
   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  'If DecimalPart
   End If   'If bUseDollars 
    
    
  'done!
   NumberAsText = NumberSign & tmp
    
End Function

Comments

PayPal Link