Convert Numbers to Words

This function will take a dollar amount and change it to words. For example if you were to enter 250.25 in the text box it would convert it to Two Hundred Fifty Dollars and Twenty Five Cents .

So start a new project and add a text box, label and command button an a form. Then add the code below to a module.

To call the function you would do the following.

Private Sub Command1_Click()
If Text1 = "" Then MsgBox "Please enter a dollor amount!": Exit Sub
Label1 = ConvertCurrencyToEnglish(Text1)
End Sub

Option Explicit

      Function ConvertCurrencyToEnglish(ByVal MyNumber)
         Dim Temp
         Dim Dollars, Cents
         Dim DecimalPlace, Count

         ReDim Place(9) As String
         Place(2) = " Thousand "
         Place(3) = " Million "
         Place(4) = " Billion "
         Place(5) = " Trillion "

         ' Convert MyNumber to a string, trimming extra spaces.
         MyNumber = Trim(Str(MyNumber))

         ' Find decimal place.
         DecimalPlace = InStr(MyNumber, ".")

         ' If we find decimal place...
         If DecimalPlace > 0 Then
            ' Convert cents
            Temp = Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2)
            Cents = ConvertTens(Temp)

            ' Strip off cents from remainder to convert.
            MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
         End If

         Count =
 

        
          
           
           

         1 Do While MyNumber
         <>  "" ' Convert
         last  3 digits of
         MyNumber  to English dollars.
         Temp =   

                 ConvertHundreds(Right(MyNumber,
         3))  If

         Temp <> "" Then
         Dollars =  

            Temp & Place(Count)
         & Dollars  If Len(MyNumber)
            > 3 Then
            '  Remove last 3 converted digits from MyNumber.
            MyNumber = 

               Left(MyNumber, Len(MyNumber) - 3) Else
            MyNumber =    ""
         End If

         Count = 
          Count +  1
            Loop ' Clean up dollars. Select Case Dollars Case ""
            Dollars =  
            "No Dollars"  Case "One" Dollars =   "One Dollar" Case
            Else Dollars =  
                  Dollars & " Dollars" End
               Select  ' Clean up cents.
            Select
               Case  Cents
            Case ""
            Cents =   
         

            "
         And No Cents"
            Case "One"
               Cents =  
             "
               And  One Cent"
            Case Else
               Cents =    
          "

         And " & Cents
         & " Cents"
            End Select
               ConvertCurrencyToEnglish =   Dollars &
            Cents End
               Function  Private Function ConvertHundreds(ByVal MyNumber)
            Dim Result
               As  String ' Exit if there is nothing to
         convert. If

         Val(MyNumber) =   
       

         
            0

         Then Exit Function ' Append leading zeros to
         number. MyNumber =    

            Right("000" & MyNumber,
         3)  ' Do we have

         a hundreds place digit to convert? If Left(MyNumber, 1) <>
         "0" Then Result =  
            ConvertDigit(Left(MyNumber,  1)) & " Hundred " End
         If '

         Do we have a tens place digit to convert? If
         Mid(MyNumber, 2, 1) <>  "0" Then
            Result = Result & ConvertTens(Mid(MyNumber, 2))
         Else
            ' If not, then convert the ones place digit.
            Result = Result & ConvertDigit(Mid(MyNumber, 3))
         End If

         ConvertHundreds = Trim(Result)
      End Function

      Private Function ConvertTens(ByVal MyTens)
         Dim Result As String

         ' Is value between 10 and 19?
         If Val(Left(MyTens, 1)) = 1 Then
            Select Case Val(MyTens)
               Case 10: Result = "Ten"
               Case 11: Result = "Eleven"
               Case 12: Result = "Twelve"
               Case 13: Result = "Thirteen"
               Case 14: Result = "Fourteen"
               Case 15: Result = "Fifteen"
               Case 16: Result = "Sixteen"
               Case 17: Result = "Seventeen"
               Case 18: Result = "Eighteen"
               Case 19: Result = "Nineteen"
               Case Else
            End Select
         Else
            ' .. otherwise it's between 20 and 99.
            Select Case Val(Left(MyTens, 1))
               Case 2: Result = "Twenty "
               Case 3: Result = "Thirty "
               Case 4: Result = "Forty "
               Case 5: Result = "Fifty "
               Case 6: Result = "Sixty "
               Case 7: Result = "Seventy "
               Case 8: Result = "Eighty "
               Case 9: Result = "Ninety "
               Case Else
            End Select

            ' Convert ones place digit.
            Result = Result & ConvertDigit(Right(MyTens, 1))
         End If

         ConvertTens = Result
      End Function

      Private Function ConvertDigit(ByVal MyDigit)
         Select Case Val(MyDigit)
            Case 1: ConvertDigit = "One"
            Case 2: ConvertDigit = "Two"
            Case 3: ConvertDigit = "Three"
            Case 4: ConvertDigit = "Four"
            Case 5: ConvertDigit = "Five"
            Case 6: ConvertDigit = "Six"
            Case 7: ConvertDigit = "Seven"
            Case 8: ConvertDigit = "Eight"
            Case 9: ConvertDigit = "Nine"
            Case Else: ConvertDigit = ""
         End Select
      End Function