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

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
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
spellnumber VBA
Replies
2
Views
689
PeggyLee
P
M
  • Locked
  • Question
SPELL NUMBER VBA
Replies
1
Views
778
Fluff
Fluff
R
  • Solved
Help : Combining Function and Sub
Replies
2
Views
442
Alex Blakenburg
A
D
  • Question
VBA for converting numbers to text in a alphanumeric value
Replies
4
Views
2K
swapnilk
S
T
  • Solved
Spellnumber function
Replies
7
Views
3K
Joe4
Joe4

Forum statistics

Threads
1,214,614
Messages
6,120,520
Members
448,968
Latest member
Ajax40

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