Converting Numeric Dollar Amounts into Text

This code will convert a numeric dollar amount into text for use in such applications as printing a check. I had to do this a couple of times in a previous life with a completely different operating system and programming language, but it is amazing how logic tends to be universal, regardless of language.

Beware: This code assumes a lot of things. It assumes that the input will be in a valid numeric format. So, either check the data before this routine begins, or put some kind of error handling in it. Also, it has an upper limit of $999,999.99 because many businesses want to limit the size of any one check. This should more properly be handled outside of this routine before an amount is ever passed to it.

For demonstration purposes I have put all of the code in the command button click event. Again, it may be more useful to have it as a function call or in a code library.

To use this routine, place two text boxes and one command button on a blank form. Text1 is where you enter the numeric dollar amount. You then click on the sommand button and Text2 is where the words will be displayed.

Copy and paste the following code into the form's general declarations

------------------

Private Sub Command1_Click()

'first set up two arrays to convert numbers to words
    Dim BigOnes(9) As String
    Dim SmallOnes(19) As String
    
'and populate them
    BigOnes(1) = "Ten"
    BigOnes(2) = "Twenty"
    BigOnes(3) = "Thirty"
    BigOnes(4) = "Forty"
    BigOnes(5) = "Fifty"
    BigOnes(6) = "Sixty"
    BigOnes(7) = "Seventy"
    BigOnes(8) = "Eighty"
    BigOnes(9) = "Ninety"
    
    SmallOnes(1) = "One"
    SmallOnes(2) = "Two"
    SmallOnes(3) = "Three"
    SmallOnes(4) = "Four"
    SmallOnes(5) = "Five"
    SmallOnes(6) = "Six"
    SmallOnes(7) = "Seven"
    SmallOnes(8) = "Eight"
    SmallOnes(9) = "Nine"
    SmallOnes(10) = "Ten"
    SmallOnes(11) = "Eleven"
    SmallOnes(12) = "Twelve"
    SmallOnes(13) = "Thirteen"
    SmallOnes(14) = "Fourteen"
    SmallOnes(15) = "Fifteen"
    SmallOnes(16) = "Sixteen"
    SmallOnes(17) = "Seventeen"
    SmallOnes(18) = "Eighteen"
    SmallOnes(19) = "Nineteen"
    
'format the incoming number to guarantee six digits
'to the left of the decimal point and two to the right
'and then separate the dollars from the cents
    Text1.Text = Format(Text1.Text, "000000.00")
    Dollars = Left(Text1.Text, 6)
    Cents = Right(Text1.Text, 2)
    
    Words = ""

'check to make sure incoming number is not too large
    If Dollars > 999999 Then
        Text2.Text = "Dollar amount is too large"
        Exit Sub
    End If
    
'separate the dollars into chunks
    If Dollars = 0 Then
        Words = "Zero"
    Else
    
'first do the thousands
        Chunk = Left(Dollars, 3)
        If Chunk > 0 Then
            GoSub ParseChunk
            Words = Words & " Thousand"
        End If
        
'do the rest of the dollars
        Chunk = Right(Dollars, 3)
        If Chunk > 0 Then
            GoSub ParseChunk
        End If
    End If
    
'concatenate the cents and display
    If Cents = 0 Then Cents = "No"
    Words = Words & " and " & Cents & "/100"
    Text2.Text = Words
    Exit Sub
    
    
ParseChunk:
    digits = Mid(Chunk, 1, 1)
    If digits > 0 Then
        Words = Words & " " & SmallOnes(digits) & " Hundred"
    End If
    digits = Mid(Chunk, 2, 2)
    If digits > 19 Then
        leftdigit = Mid(Chunk, 2, 1)
        rightdigit = Mid(Chunk, 3, 1)
        Words = Words & " " & BigOnes(leftdigit)
        If rightdigit > 0 Then
            Words = Words & " " & SmallOnes(rightdigit)
        End If
    Else
        If digits > 0 Then
            Words = Words & " " & SmallOnes(digits)
        End If
    End If
    Return

End Sub

---------------------------------------------------------------------
Original project from this tip by PINERYJIM@aol.com  
by Burt Abreu. An updated version of this project is 
available below (VB6 Sample 2) and was created 
by Brian Duckworth.
---------------------------------------------------------------------

Download VB6 Sample 1

Updated Version

'*****************************
'Re-written as a class module
'by Brian Duckworth
'*****************************

I've place the conversion code into a class component so that it can be dropped into any project. Although I used VB6 to develop it, you should have no problem using it with VB5.

To test it, you'll need a form and a class module. The form's code comments contain the required controls to place on the form.

You may notice that this code allows for a rather large range of valid values. I accomplished this without loss of precision by using the rather obscure data type of Decimal (refer to the CDec function in the help for a description of this data type).

'*******************************************************************************
'Form:  FMoney
'
'The form contains four controls:
'   Text1        - Holds numeric value to convert
'   RichTextBox1 - Holds results of conversion
'   Command1     - Triggers the conversion
'   Command2     - Exits the program
'
'Add the above four controls and cut-and-paste the following as the form's
'procedural code.
'*******************************************************************************

Option Explicit

Private Sub Command1_Click()
  Dim Money As CMoney
  
  Set Money = New CMoney
  RichTextBox1.Text = Money.MonetaryToWords(Text1.Text)
  Set Money = Nothing
End Sub

Private Sub Command2_Click()
  Unload Me
End Sub


'*******************************************************************************
'Class Module:  CMoney
'
'Cut-and-paste the following as the class' procedural code.
'*******************************************************************************

Option Explicit
  
'Persist the "words" across all calls to this class
Private m_19AndUnder(0 To 19) As String
Private m_Tens(2 To 9)        As String
Private m_Hundred             As String
Private m_Groups(1 To 10)     As String
Private m_Dollar              As String
Private m_Dollars             As String
Private m_NoCents             As String
Private m_Cent                As String
Private m_Cents               As String
Private m_Hyphen              As String
Private m_And                 As String
Private m_InvalidAmount       As String

Private Sub Class_Initialize()
  'Initialize all the "words"
  
  m_19AndUnder(0) = "Zero"
  m_19AndUnder(1) = "One"
  m_19AndUnder(2) = "Two"
  m_19AndUnder(3) = "Three"
  m_19AndUnder(4) = "Four"
  m_19AndUnder(5) = "Five"
  m_19AndUnder(6) = "Six"
  m_19AndUnder(7) = "Seven"
  m_19AndUnder(8) = "Eight"
  m_19AndUnder(9) = "Nine"
  m_19AndUnder(10) = "Ten"
  m_19AndUnder(11) = "Eleven"
  m_19AndUnder(12) = "Twelve"
  m_19AndUnder(13) = "Thirteen"
  m_19AndUnder(14) = "Fourteen"
  m_19AndUnder(15) = "Fifteen"
  m_19AndUnder(16) = "Sixteen"
  m_19AndUnder(17) = "Seventeen"
  m_19AndUnder(18) = "Eighteen"
  m_19AndUnder(19) = "Nineteen"
  
  m_Tens(2) = "Twenty"
  m_Tens(3) = "Thirty"
  m_Tens(4) = "Forty"
  m_Tens(5) = "Fifty"
  m_Tens(6) = "Sixty"
  m_Tens(7) = "Seventy"
  m_Tens(8) = "Eighty"
  m_Tens(9) = "Ninety"
  
  m_Hundred = "Hundred"
  
  m_Groups(1) = ""
  m_Groups(2) = "Thousand"
  m_Groups(3) = "Million"
  m_Groups(4) = "Billion"
  m_Groups(5) = "Trillion"
  m_Groups(6) = "Quadrillion"
  m_Groups(7) = "Quintillion"
  m_Groups(8) = "Sextillion"
  m_Groups(9) = "Septillion"
  m_Groups(10) = "Octillion"
  
  m_Dollar = " Dollar"
  m_Dollars = " Dollars"
  
  m_NoCents = "No Cents"
  'm_Cent & m_Cents could both be changed to "/100"
  m_Cent = " Cent"
  m_Cents = " Cents"
  
  'Used for #s like: 23 = "Twenty-Three"
  m_Hyphen = "-"
  
  'Used between dollars & cents: "One Dollar and 12 Cents"
  m_And = " and "
  
  m_InvalidAmount = "Invalid Dollar Amount."
End Sub

Public Function MonetaryToWords(Value As Variant) As String
  Dim decValue    As Variant
  Dim sValue      As String
  Dim iDecimal    As Integer
  Dim sCents      As String
  Dim sDollars    As String
  
  On Error GoTo ER
  
  'Convert input into a Decimal value (up to 28 digits)
  decValue = CDec(Value)
  If decValue <0 Then GoTo ER 'Convert the Decimal value back into a string. This eliminates ' any format characters such as "$" or ",". sValue="CStr(decValue)" 'Find the decimal point & extract the dollars from the cents iDecimal="InStr(1," sValue, ".") If iDecimal="0" Then sDollars="sValue" sCents="00" Else 'Extract decimal value sCents="Mid$(sValue," iDecimal + 1) If Len(sCents)> 2 Then GoTo ER
    
    'Extract dollars
    sDollars = Left$(sValue, iDecimal - 1)
    
    'Fill-out decimal places to two digits
    sCents = Left$(sCents & "00", 2)
  End If
  
  'At this point,
  '  sDollars = the whole dollar value (0.. approx 79 Octillion)
  '  sCents   = the cents (00..99)
  
  Debug.Assert Len(sCents) = 2
  Debug.Assert Len(sDollars) > 0
  Debug.Assert Len(sDollars) <31 Select Case sCents Case "00" sCents="m_NoCents" Case "01" sCents="sCents" & m_Cent Case Else sCents="sCents" & m_Cents End Select MonetaryToWords="DollarsToWords(sDollars)" & m_And & sCents Exit Function ER: MonetaryToWords="m_InvalidAmount" End Function Private Function DollarsToWords(sDollars As String) As String Dim sWords As String Dim decValue As Variant Dim sRemaining As String Dim s3Digits As String Dim iGroup As Integer Dim i100s As Integer Dim i10s As Integer Dim i1s As Integer Dim i99OrLess As Integer Dim sWork As String 'We had better be passing a valid number Debug.Assert IsNumeric(sDollars) 'Check for special cases. This also serves to validate the value decValue="CDec(sDollars)" Select Case decValue Case 0 DollarsToWords="m_19AndUnder(decValue)" & m_Dollars Exit Function Case 1 DollarsToWords="m_19AndUnder(decValue)" & m_Dollar Exit Function End Select 'There should be no insignificant zeroes, "punctuation" or decimals Debug.Assert sDollars="CStr(decValue)" iGroup="0" sRemaining="sDollars" sWords 'Extract each group of three digits, convert to words and prefix to result While Len(sRemaining)> 0
    iGroup = iGroup + 1
    
    'Extract next group of three digits
    If Len(sRemaining) > 3 Then
      s3Digits = Right$(sRemaining, 3)
      sRemaining = Left$(sRemaining, Len(sRemaining) - 3)
    Else
      'Fill-out group to three digits
      s3Digits = Right$("00" & sRemaining, 3)
      sRemaining = ""
    End If
    
    Debug.Assert Len(s3Digits) = 3
    
    If s3Digits <> "000" Then
      i100s = CInt(Left$(s3Digits, 1))
      i10s = CInt(Mid$(s3Digits, 2, 1))
      i1s = CInt(Right$(s3Digits, 1))
      i99OrLess = (i10s * 10) + i1s
      sWork = " " & m_Groups(iGroup)
      
      Select Case True
        'Do we have 20..99?
        Case i10s > 1
          Debug.Assert i10s <= 9 If i1s> 0 Then
            Debug.Assert i1s <= 9 sWork="m_Tens(i10s)" & m_Hyphen & m_19AndUnder(i1s) & sWork Else sWork="m_Tens(i10s)" & sWork End If 'Do we have 01..19? Case i99OrLess> 0
          Debug.Assert i99OrLess <= 99 sWork="m_19AndUnder(i99OrLess)" & sWork Case Else 'If we're here, it's because there are no tens or ones Debug.Assert i99OrLess="0" Debug.Assert i10s="0" Debug.Assert i1s="0" Debug.Assert Right$(s3Digits, 2)="00" 'If there's no tens or ones, there better be hundreds Debug.Assert i100s> 0
          
      End Select
      
      If i100s > 0 Then
        Debug.Assert i100s <= 9 sWork="m_19AndUnder(i100s)" & " " & m_Hundred & " " & sWork End If Debug.Assert Len(Trim$(sWork))> 0
      
      sWords = sWork & " " & sWords
    End If
  Wend
  
  DollarsToWords = Trim$(sWords) & m_Dollars
End Function

---------------------------------------------------------------------
Updated VB6 project from the original tip 
was created by Brian Duckworth.
---------------------------------------------------------------------

Download VB6 Sample 2