Help in Modify VBA code about converting numbers to Words

[AlaaEddin]

Hello there,,,

What I want that when a number 100 or 1000 or 1000000 or ... is placed I don't want the result to be "One Hundred" , "One Thousand" , "One Million" , etc. I want the result to be "Hundred", "Thousand", "Million" , "Trillion" , etc.

How I can perform that I tried for about 1 hour I have not that big knowledge in VB language so I need your help below the VB Code:

Function NumberstoWords(ByVal pNumber)
'Updateby20140220
Dim Dollars
arr = Array("", "", " Thousand ", " Million ", " Billion ", " Trillion ")
pNumber = Trim(Str(pNumber))
xDecimal = InStr(pNumber, ".")
If xDecimal > 0 Then
pNumber = Trim(Left(pNumber, xDecimal - 1))
End If
xIndex = 1
Do While pNumber <> ""
xHundred = ""
xValue = Right(pNumber, 3)
If Val(xValue) <> 0 Then
xValue = Right("000" & xValue, 3)
If Mid(xValue, 1, 1) <> "0" Then
xHundred = " Hundred "
End If
If Mid(xValue, 2, 1) <> "0" Then
xHundred = xHundred & GetTens(Mid(xValue, 2))
Else
xHundred = xHundred & GetDigit(Mid(xValue, 3))
End If
End If
If xHundred <> "" Then
Dollars = xHundred & arr(xIndex) & Dollars
End If
If Len(pNumber) > 3 Then
pNumber = Left(pNumber, Len(pNumber) - 3)
Else
pNumber = ""
End If
xIndex = xIndex + 1
Loop
NumberstoWords = Dollars
End Function
Function GetTens(pTens)
Dim Result As String
Result = ""
If Val(Left(pTens, 1)) = 1 Then
Select Case Val(pTens)
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
Select Case Val(Left(pTens, 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
Result = Result & GetDigit(Right(pTens, 1))
End If
GetTens = Result
End Function
Function GetDigit(pDigit)
Select Case Val(pDigit)
Case 1: GetDigit = "One"
Case 2: GetDigit = "Two"
Case 3: GetDigit = "Three"
Case 4: GetDigit = "Four"
Case 5: GetDigit = "Five"
Case 6: GetDigit = "Six"
Case 7: GetDigit = "Seven"
Case 8: GetDigit = "Eight"
Case 9: GetDigit = "Nine"
Case Else: GetDigit = ""
End Select
End Function

I am looking further for your help
thanks.

 

[Richard U]

Function MakeWords(pnum As String)


Dim lenCtr As Integer
Dim build_Str As String
Dim str_in As String
Dim numStr() As String
Dim ctr As Integer
Dim base(1 To 19)
Dim base10(2 To 10)
Dim bounds As Integer
Dim tmp_str As String

Dim morethan99(1 To 10)
base(1) = "one"
base(2) = "two"
base(3) = "three"
base(4) = "four"
base(5) = "five"
base(6) = "six"
base(7) = "seven"
base(8) = "eight"
base(9) = "nine"
base(10) = "ten"
base(11) = "eleven"
base(12) = "twelve"
base(13) = "thirteen"
base(14) = "fourteen"
base(15) = "fifteen"
base(16) = "sixteen"
base(17) = "seventeen"
base(18) = "eightteen"
base(19) = "nineteen"

base10(2) = "twenty"
base10(3) = "thirty"
base10(4) = "tourty"
base10(5) = "tifty"
base10(6) = "sixty"
base10(7) = "seventy"
base10(8) = "eighty"
base10(9) = "ninety"
base10(10) = "Hundred"
 

morethan99(5) = "thousand"
morethan99(4) = "million"
morethan99(3) = "billion"
morethan99(2) = "trillion"
morethan99(1) = "quadrillion"
morethan99(6) = ""

Do Until Len(pnum) Mod 3 = 0
    pnum = "0" & pnum
Loop
bounds = (Len(pnum) / 3)
ReDim numStr(1 To bounds)

For ctr = 1 To UBound(numStr)

    numStr(ctr) = Left(pnum, 3)
    pnum = Right(pnum, Len(pnum) - 3)
Next ctr


lenCtr = Len(pnum)
build_Str = " "
For ctr = 1 To UBound(numStr)
    
    If Right(build_Str, 1) = "" Then
        tmp_str = " "
    Else
        tmp_str = ""
    End If
    
    If CInt(Left(numStr(ctr), 1)) > 0 Then
        build_Str = tmp_str & build_Str & base(Left(numStr(ctr), 1)) & " " & base10(10) & " "
    End If
    
    If Right(build_Str, 1) = "" Then
        tmp_str = " "
    Else
        tmp_str = ""
    End If
    
    If CInt(Mid(numStr(ctr), 2, 1)) > 0 And CInt(Mid(numStr(ctr), 2, 1)) < 2 Then
        build_Str = tmp_str & build_Str & base(Mid(numStr(ctr), 2, 2)) & " " & base10(10) & " "
    
    Else
        If CInt(Mid(numStr(ctr), 2, 1)) > 1 Then
            build_Str = tmp_str & build_Str & base10(Mid(numStr(ctr), 2, 1)) & " "
        End If
        
        If Right(build_Str, 1) = "" Then
            tmp_str = " "
        Else
            tmp_str = ""
        End If
        If CInt(Mid(numStr(ctr), 3, 1)) > 0 Then
            build_Str = tmp_str & build_Str & base(Mid(numStr(ctr), 3, 1)) & " "
        End If
    End If
    build_Str = tmp_str & build_Str & morethan99(ctr) & " "
Next ctr
MakeWords = Trim(build_Str)
End Function

 

[AlaaEddin]

Thank you for your reply but the code above doesn't solve the problem but makes more problems

https://ibb.co/bWV18A\

Thanks

 

[AlaaEddin]

I gave you the code and I told you that I don't want numbers to start with the word "One" for example:

100 -> Hundred
1000 -> Thousand
... -> ...

I will let you know why... because I am going to convert it to Turkish language and in Turkish Language it's wrong to start with "One" = "Bir" so I need to poll it out

Thanks.

 

[AlaaEddin]

Anyone to help guys it's simple if you are good in VBA but VBA isn't my main work I am waiting it's really important so please help me

Thanks

 

[Richard U]

Change

If CInt(Mid(numStr(ctr), 3, 1)) > 0 Then

to

If CInt(Mid(numStr(ctr), 3, 1)) > 1 Then

 

[AlaaEddin]

fixed the issue of starting with one but the results still not logical and wrong

 

[AlaaEddin]

quadrillion and trillion keeps adding to all numbers for example:

1525 = quadrillion five Hundred twenty five trillion

 

[AlaaEddin]

You still there guys?