CodeItBetter Programming Another VB Programming Blog

'String Manipulation - How to Convert Dollar Amounts into Words
Option Explicit
 
Dim Arr1 As Variant
Dim Arr10 As Variant
 
' Code good for 0 to 99999.99
Private Sub GetWords(Amt As Currency)
    Dim d1 As Long
    Dim d10 As Long
    Dim d100 As Long
    Dim d1000 As Long
    Dim c1 As Long
    Dim c10 As Long
    Dim Words As String
    Dim Amount As Double
    Dim tmpAmt As Double
    ' Dollar Processing
    Amount = Amt
    d1000 = Int(Amount / 1000): Amount = Amount - (d1000 * 1000)
    d100 = Int(Amount / 100): Amount = Amount - CDbl(d100 * 100)
    d10 = Int(Amount / 10): Amount = Amount - CDbl(d10 * 10)
    d1 = Int(Amount): Amount = Amount - d1
    ' Cents Processing
    Amount = Amount * 100
    c10 = Int(Amount / 10): Amount = Amount - (c10 * 10)
    c1 = Int(Amount): Amount = Amount - c1
    Words = ""
    ' Dollars Words Processing
    If d1000 > 19 Then
        Amount = d1000
        Words = Words & Arr10(Int(d1000 / 10)): Amount = (d1000 Mod 10)
        If Amount > 0 Then Words = Words & " " & Arr1(Amount)
        Words = Words & " Thousand "
    Else
        If d1000 > 0 Then Words = Words & Arr1(d1000) & " Thousand "
    End If
    Words = Words & GetHundreds(d100)
    'If d100 > 0 Then Words = Words & Arr1(d100) & " Hundred "
    Words = Words & GetTens(d1, d10, " Dollars")
    ' Cents Words Processing
    Words = Words & " and " & GetTens(c1, c10, " Cents")
    MsgBox Words
    Text1.Text = ""
End Sub
 
Function GetTens(iones As Long, itens As Long, stype As String) As String
    Dim ones, tens As Integer
    ones = iones
    tens = itens
    If ones > 0 And tens = 1 Then
        GetTens = GetTens & Arr1(ones + (tens * 10)) & " "
        ones = 0
    Else
        GetTens = GetTens & Arr10(tens) & " "
    End If
    If ones > 0 Then
        GetTens = GetTens & Arr1(ones) & stype
    Else
        GetTens = "Zero" & stype
    End If
End Function
 
Function GetHundreds(iHundreds As Long) As String
    If iHundreds > 0 Then GetHundreds = Arr1(iHundreds) & " Hundred "
End Function
 
Private Sub Command1_Click()
    GetWords CCur(Val(Text1.Text))
End Sub
 
Private Sub Form_Load()
    Arr1 = Array("", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine", _
                 "Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", _
                 "Seventeen", "Eighteen", "Ninteen")
    Arr10 = Array("", "Ten", "Twenty", "Thirty", "Fourty", "Fifty", "Sixty", "Seventy", "Eighty", "Ninety")
End Sub