Need Troubleshooting Help [resolved]

[mrstuff68]

I have an application that changes and $$ amount into a written out ammount. Ex. 250$ = Two Hundred Fifty Dollars. I have the following code that i want to modify, but i have found that it doesnt correctly translate the cents part, can you guys help me out on this one and tell me what is causing this, it doesnt always translate incorrectly only on certain occasions. I only have a text box and a command button so it should be easy to set up.

Example: 243.42 = Two hundres forty three dollars and forty one cents
another example: 96.86 = Ninety Six Dollars and Eighty Five cents
while when you do 6.32 it comes up correctly. What is causing this cause i cant find it.

Thanks for you help in advance.

Option Explicit

Dim Arr1 As Variant
Dim Arr10 As Variant
Dim Arr100 As Variant

Private Sub GetWords(Amt As Currency)
Dim d1 As Long
Dim d10 As Long
Dim d100 As Long
Dim d1000 As Long
Dim d100000 As Long
Dim d1000000 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

d1000000 = Int(Amount / 1000000): Amount = Amount - (d1000000 * 1000000)
d100000 = Int(Amount / 100000): Amount = Amount - (d100000 * 100000)
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 d1000000 > 0 Then
   If d1000000 < 19 Then
       Amount = d1000000
       Words = Words & Arr1(d1000000) & " Million "
    Else
    If d1000000 > 19 Then
       Amount = d1000000
       Words = Words & Arr100(Int(d1000000 / 10)): Amount = (d1000000 Mod 10)
       If Amount > 0 Then Words = Words & " " & Arr1(Amount)
       Words = Words & " Million "
    Else
       If d1000 = 0 Then Words = Words & Arr1(d1000000) & " Million "
    End If
End If
End If
If d100000 > 0 Then
    Words = Words & GetHundreds(Int(d100000 / 10)): Amount = (d100000 Mod 10)
    If (Amount > 0 And d1000 = 0) Then
        Words = Words & Arr1(d100000) & " Hundred Thousand "
    Else
    If d1000 > 0 Then Words = Words & Arr1(d100000) & " Hundred "
    
    End If
End If

If d1000 > 19 Then
   Amount = d1000
   Words = Words & Arr100(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)
Words = Words & GetTens(d1, d10, " Dollars")

'///////////////////////////
' Cents Words Processing
'///////////////////////////

Words = Words & " and " & GetCents(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 & Arr100(tens) & " "
    End If
    
    If ones > 0 Then
       GetTens = GetTens & Arr1(ones) & stype
    Else
       GetTens = stype
    End If

End Function
Function GetCents(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
       GetCents = GetCents & Arr1(ones + (tens * 10)) & " "
       ones = 0
    Else
       GetCents = GetCents & Arr100(tens) & " "
    End If
    
    If ones > 0 Then
       GetCents = GetCents & Arr1(ones) & stype
    Else
       GetCents = "Zero" & stype
    End If

End Function

Function GetHundreds(iHundreds As Long) As String
    If iHundreds > 0 Then GetHundreds = Arr1(iHundreds) & " Hundred "
End Function
Function GetHundredsThs(iHundreds As Long) As String
    If iHundreds > 0 Then GetHundredsThs = 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("", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine")
Arr100 = Array("", "Ten", "Twenty", "Thirty", "Fourty", "Fifty", "Sixty", "Seventy", "Eighty", "Ninety")

End Sub 

[BruceG]

I have a sample app on my site that converts a number to words. It is implemented as a function "Num2Words". It only works on integers. To do what you want, you will need to call the function twice. Break up your string at the decimal point (you can use Split or other string-handling functions to do this), then call the routine once passing it the "dollars" portion and append the text " dollars and ", then call it again passing it the "cents" portion, and append that result along with the word "cents" to the final result.

The code can be found here:
http://www.thevbprogrammer.com/index...ter=8&Topic=11

[mrstuff68]

BruceG, I will look into your app, but i would still like to know what is causing the code that i currently have to act the way it is. If it was happening all the time then i would know that there is something wrong with the code but if it acts like that on certain instances, i would really like to know what is causing it.

[dglienna]

You are using LONG's which don't handle division well. The drawback to using SINGLE is that there is a range limit of 32768. You could use Currency type though, which should be what you need. Change the type of C1 and C10 for sure, to solve your problem.

[mrstuff68]

I knew it was something small.

Thanks dglienna

[Pradeep1210]

Ever since I discovered CHOOSE function, it has made my functions very small in cases like this one.

Private Sub Command1_Click()
    '*** Usage ***
    MsgBox AmountToWords(InputBox("Enter Amount:"))
End Sub

Private Function AmountToWords(ByVal num As Double)
    Dim s As String, sa() As String
    
    'Rupees part
    s = Int(num)
    s = Format(s, "-##-##-##-##-##-#-##")
    Do While InStr(s, "--") > 0
        s = Replace(s, "--", "-")   'remove extra seperators
    Loop
    If s = "-" Then
        AmountToWords = "Rupees Zero"
    Else
        sa = Split(s, "-")
        For i = UBound(sa) To 1 Step -1
            AmountToWords = GetNum(sa(i)) & GetPlace(sa(i), UBound(sa) - i + 1) & AmountToWords
        Next
        AmountToWords = "Rupees " & AmountToWords
    End If
    
    'Paise Part
    If Int(num) <> num Then
        s = Format(num, "0.00")
        s = Mid(s, InStr(s, ".") + 1, 2)
        AmountToWords = AmountToWords & " and " & GetNum(s) & " paise"
    End If
    AmountToWords = AmountToWords & " only"
End Function

Private Function GetNum(ByVal num As Long) As String
    Select Case num
    Case 0
'        GetNum = "zero"
    Case Is < 11
        GetNum = Choose(num, "one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten")
    Case Is < 20
        GetNum = Choose(num - 10, "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eighteen", "nineteen")
    Case Is < 100
        GetNum = Choose(num \ 10, "ten", "twenty", "thirty", "forty", "fifty", "sixty", "seventy", "eighty", "ninety")
        GetNum = GetNum & " " & GetNum(num Mod 10)
    End Select
End Function

Private Function GetPlace(ByVal num As Long, ByVal nPlace As Long) As String
    If num > 0 Then GetPlace = Choose(nPlace, "", " hundred ", " thousand ", " lakh ", " crore ", " million ", " billion ", " trillion ")
End Function