Need help on the spell number coding

M

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

How to show all formulas in Excel?
Press Ctrl+` to show all formulas. Press it again to toggle back to numbers. The grave accent is often under the tilde on US keyboards.
Sort by date Sort by votes
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
Zot said:
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
Click to expand...
Hi, it doesn't work as the work "only" will repeated when the numbers has decimals. See below:

Thank you

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

Thank you

View attachment 82595
Click to expand...

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
munhow1223 said:
doesn't work as the w
Zot said:
Not sure why you got th
Zot said:
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
Click to expand...

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
Click to expand...

ork "only" will repeated when the numbers has decimals. See below:
Click to expand...
Zot said:
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
Click to expand...

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
You must log in or register to reply here.

Similar threads

P
  • Question Question
spellnumber VBA
Replies
2
Views
1K
PeggyLee
P
M
  • Locked
  • Question Question
SPELL NUMBER VBA
Replies
1
Views
1K
Fluff
Fluff
R
  • Solved
Help : Combining Function and Sub
Replies
2
Views
562
Alex Blakenburg
A
D
  • Question Question
VBA for converting numbers to text in a alphanumeric value
Replies
4
Views
2K
swapnilk
S
G
  • Solved
run VBA when clicked
Replies
4
Views
94
Gylle
G

Forum statistics

Threads
1,223,236
Messages
6,170,915
Members
452,366
Latest member
TePunaBloke

Share this page

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