Need help on the spell number coding

munhow1223

New Member
Joined
Jan 11, 2023
Messages
4
Office Version
  1. 2019
Platform
  1. Windows
Hi there everyone, need help on the below VBA code .

As attached below, numbers without decimals wont show "only" at behind, Example (18) . whereas amount with cents, it will show the word "only". How do i amend the code ? Thank you

**What i need:
Number: 18
Output: Ringgit Malaysia Eighteen only


1673485080648.png



Function readmoney_Mei(ByVal pNumber)

Dim Ringgit, Cents
arr = Array("", "", " Thousand ", " Million ", " Billion ", " Trillion ")
pNumber = Trim(Str(pNumber))
xDecimal = InStr(pNumber, ".")
If xDecimal > 0 Then
Cents = GetTens(Left(Mid(pNumber, xDecimal + 1) & "00", 2))
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 = GetDigit(Mid(xValue, 1, 1)) & " 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
Ringgit = xHundred & arr(xIndex) & Ringgit
End If
If Len(pNumber) > 3 Then
pNumber = Left(pNumber, Len(pNumber) - 3)
Else
pNumber = ""
End If
xIndex = xIndex + 1
Loop
Select Case Ringgit
Case ""
Ringgit = ""
Case "One"
Ringgit = "Ringgit Malaysia One Ringgit" & " only"
Case Else
Ringgit = "Ringgit Malaysia " & Ringgit
End Select
Select Case Cents
Case ""
Cents = ""
Case "One"
Cents = " Ringgit Malaysia One Cent"
Case Else
Cents = "And Cents " & Cents & " only"
End Select
readmoney_Mei = Ringgit & Cents
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
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
I'm not going to try and read that code because none of it is indented. Use vba tags (VBA Icon on posting toolbar) to maintain indentation and readability.
Perhaps solve your issue with an IF block in your code somewhere:
If Not Right(ringgit,5) = "only" Then ringgit = ringgit & " only"
OR don't put it in anywhere along the way - just add it at the end (it seems you want it on every line anyway).

Concatenating this: Ringgit = "Ringgit Malaysia One Ringgit" & " only"
makes no sense (but then again, I didn't try to read that code). It might as well just be Ringgit = "Ringgit Malaysia One Ringgit only" ?
 
Upvote 0
Modify this part
Rich (BB code):
Select Case Ringgit
Case ""
Ringgit = ""
Case "One"
Ringgit = "Ringgit Malaysia One Ringgit" & " only"
Case Else
Ringgit = "Ringgit Malaysia " & Ringgit & " only"
End Select
 
Upvote 0
Modify this part
Rich (BB code):
Select Case Ringgit
Case ""
Ringgit = ""
Case "One"
Ringgit = "Ringgit Malaysia One Ringgit" & " only"
Case Else
Ringgit = "Ringgit Malaysia " & Ringgit & " only"
End Select
Hi, it doesn't work as the work "only" will repeated when the numbers has decimals. See below:

Thank you

1673513023376.png
 
Upvote 0
Hi, it doesn't work as the work "only" will repeated when the numbers has decimals. See below:

Thank you

View attachment 82595

Not sure why you got that but it just ran just fine on mine. I made minor alteration for space and change word Cents to Sen because Malaysia currency is Ringgit and Sen :)

VBA Code:
Function readmoney_Mei(ByVal pNumber)

Dim Ringgit, Cents

arr = Array("", "", " Thousand ", " Million ", " Billion ", " Trillion ")
pNumber = Trim(Str(pNumber))
xDecimal = InStr(pNumber, ".")
If xDecimal > 0 Then
    Cents = GetTens(Left(Mid(pNumber, xDecimal + 1) & "00", 2))
    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 = GetDigit(Mid(xValue, 1, 1)) & " 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
        Ringgit = xHundred & arr(xIndex) & Ringgit
    End If
    If Len(pNumber) > 3 Then
        pNumber = Left(pNumber, Len(pNumber) - 3)
    Else
        pNumber = ""
    End If
    xIndex = xIndex + 1
Loop

Select Case Ringgit
    Case ""
        Ringgit = ""
    Case "One"
        Ringgit = "Ringgit Malaysia One " & " only"
    Case Else
        Ringgit = "Ringgit Malaysia " & Ringgit
End Select
Select Case Cents
    Case ""
        Cents = ""
    Case "One"
        Cents = " Ringgit Malaysia One Cent"
    Case Else
        Cents = "And Sen " & Cents & " only"
End Select
readmoney_Mei = Ringgit & Cents

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
 
Upvote 0
doesn't work as the w
Not sure why you got th
Not sure why you got that but it just ran just fine on mine. I made minor alteration for space and change word Cents to Sen because Malaysia currency is Ringgit and Sen :)

VBA Code:
Function readmoney_Mei(ByVal pNumber)

Dim Ringgit, Cents

arr = Array("", "", " Thousand ", " Million ", " Billion ", " Trillion ")
pNumber = Trim(Str(pNumber))
xDecimal = InStr(pNumber, ".")
If xDecimal > 0 Then
    Cents = GetTens(Left(Mid(pNumber, xDecimal + 1) & "00", 2))
    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 = GetDigit(Mid(xValue, 1, 1)) & " 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
        Ringgit = xHundred & arr(xIndex) & Ringgit
    End If
    If Len(pNumber) > 3 Then
        pNumber = Left(pNumber, Len(pNumber) - 3)
    Else
        pNumber = ""
    End If
    xIndex = xIndex + 1
Loop

Select Case Ringgit
    Case ""
        Ringgit = ""
    Case "One"
        Ringgit = "Ringgit Malaysia One " & " only"
    Case Else
        Ringgit = "Ringgit Malaysia " & Ringgit
End Select
Select Case Cents
    Case ""
        Cents = ""
    Case "One"
        Cents = " Ringgit Malaysia One Cent"
    Case Else
        Cents = "And Sen " & Cents & " only"
End Select
readmoney_Mei = Ringgit & Cents

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

word Cents to Sen because Malaysia currency is Ringgit and Sen :)

VBA Code:
Function readmoney_Mei(ByVal pNumber)

Dim Ringgit, Cents

arr = Array("", "", " Thousand ", " Million ", " Billion ", " Trillion ")
pNumber = Trim(Str(pNumber))
xDecimal = InStr(pNumber, ".")
If xDecimal > 0 Then
    Cents = GetTens(Left(Mid(pNumber, xDecimal + 1) & "00", 2))
    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 = GetDigit(Mid(xValue, 1, 1)) & " 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
        Ringgit = xHundred & arr(xIndex) & Ringgit
    End If
    If Len(pNumber) > 3 Then
        pNumber = Left(pNumber, Len(pNumber) - 3)
    Else
        pNumber = ""
    End If
    xIndex = xIndex + 1
Loop

Select Case Ringgit
    Case ""
        Ringgit = ""
    Case "One"
        Ringgit = "Ringgit Malaysia One " & " only"
    Case Else
        Ringgit = "Ringgit Malaysia " & Ringgit
End Select
Select Case Cents
    Case ""
        Cents = ""
    Case "One"
        Cents = " Ringgit Malaysia One Cent"
    Case Else
        Cents = "And Sen " & Cents & " only"
End Select
readmoney_Mei = Ringgit & Cents

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

ork "only" will repeated when the numbers has decimals. See below:
Not sure why you got that but it just ran just fine on mine. I made minor alteration for space and change word Cents to Sen because Malaysia currency is Ringgit and Sen :)

VBA Code:
Function readmoney_Mei(ByVal pNumber)

Dim Ringgit, Cents

arr = Array("", "", " Thousand ", " Million ", " Billion ", " Trillion ")
pNumber = Trim(Str(pNumber))
xDecimal = InStr(pNumber, ".")
If xDecimal > 0 Then
    Cents = GetTens(Left(Mid(pNumber, xDecimal + 1) & "00", 2))
    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 = GetDigit(Mid(xValue, 1, 1)) & " 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
        Ringgit = xHundred & arr(xIndex) & Ringgit
    End If
    If Len(pNumber) > 3 Then
        pNumber = Left(pNumber, Len(pNumber) - 3)
    Else
        pNumber = ""
    End If
    xIndex = xIndex + 1
Loop

Select Case Ringgit
    Case ""
        Ringgit = ""
    Case "One"
        Ringgit = "Ringgit Malaysia One " & " only"
    Case Else
        Ringgit = "Ringgit Malaysia " & Ringgit
End Select
Select Case Cents
    Case ""
        Cents = ""
    Case "One"
        Cents = " Ringgit Malaysia One Cent"
    Case Else
        Cents = "And Sen " & Cents & " only"
End Select
readmoney_Mei = Ringgit & Cents

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

Hi Zot, Thanks again but still not working dont know why. It works fine without the decimals but the word "Only" will repeated when the numbers has a decimals.


1673518313983.png
 
Upvote 0

Forum statistics

Threads
1,223,903
Messages
6,175,284
Members
452,630
Latest member
OdubiYouth

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top