HELP! I need spell number to round decimals??

JocelynR

New Member
Joined
Aug 13, 2015
Messages
3
Hello, I am using the Spell Number Module as Follows:

Option Explicit
'Main Function
Function SpellNumber(ByVal MyNumber)
Dim Dollars, Cents, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " Thousand "
Place(3) = " Million "
Place(4) = " Billion "
Place(5) = " Trillion "

MyNumber = Trim(Str(MyNumber))
DecimalPlace = InStr(MyNumber, ".")
If DecimalPlace > 0 Then
Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
Count = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Dollars
Case ""
Dollars = "No Dollars"
Case "One"
Dollars = "One Dollar"
Case Else
Dollars = Dollars & " Dollars"
End Select
Select Case Cents
Case ""
Cents = " and No Cents"
Case "One"
Cents = " and One Cent"
Case Else
Cents = " and " & Cents & " Cents"
End Select
SpellNumber = Dollars & Cents
End Function

Function GetHundreds(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
' Convert the hundreds place.
If Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
End If
' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(MyNumber, 2))
Else
Result = Result & GetDigit(Mid(MyNumber, 3))
End If
GetHundreds = Result
End Function

Function GetTens(TensText)
Dim Result As String
Result = "" ' Null out the temporary function value.
If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
Select Case Val(TensText)
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 ' If value between 20-99...
Select Case Val(Left(TensText, 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(TensText, 1)) ' Retrieve ones place.
End If
GetTens = Result
End Function

Function GetDigit(Digit)
Select Case Val(Digit)
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

My issue is instead of writing the number in a cell that I want spelled in english i need it to spell a answer to a formula... So while it rounds the number for the formula to make it a currency ie. 14.775 = $14.78 it spells out "fourteen dollars and seventy seven cents" I need it to round like the number does to say "fourteen dollars and seventy eight cents

Is there anyway i can modify the module above to do this?
 

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
you can try mine:
Code:
'spell out the number given (like on a check)
'NO COMMAS
Public Function SpellNum(Optional ByVal psNum)
Dim vTxt, vNum, vWord, vN1, vN2
Dim x As Integer, l As Integer, i As Integer
Dim vCents

If IsMissing(psNum) Then
   SpellNum = ""
   Exit Function
End If

If InStr(psNum, ".") > 0 Then
     i = InStr(psNum, ".")
     vCents = Mid(psNum, i + 1)
     psNum = Left(psNum, i - 1)
End If


If Len(psNum) = 1 And Val(psNum) = 0 Then
   SpellNum = "ZERO"
   Exit Function
End If

If Val(psNum) = 0 Then
  i = -1
Else
  i = Len(psNum)
End If

Select Case i
Case -1
   SpellNum = ""
   Exit Function

Case 1
    x = 0
    Select Case Val(psNum)
    Case 0
        vTxt = ""
    Case 1
        vTxt = "ONE "
    Case 2
        vTxt = "TWO "
    Case 3
        vTxt = "THREE "
    Case 4
        vTxt = "FOUR "
    Case 5
        vTxt = "FIVE "
    Case 6
        vTxt = "SIX "
    Case 7
        vTxt = "SEVEN "
    Case 8
        vTxt = "EIGHT "
    Case 9
        vTxt = "NINE "
    End Select
    
Case 2
    x = 0
    Select Case Val(psNum)
       Case 10
         vTxt = "TEN "
       Case 11
         vTxt = "ELEVEN "
       Case 12
         vTxt = "TWELVE "
       Case 13
         vTxt = "THIRTEEN "
       Case 14
         vTxt = "FORTEEN "
       Case 15
         vTxt = "FIFTEEN "
       Case 16
         vTxt = "SIXTEEN "
       Case 17
         vTxt = "SEVENTEEN "
       Case 18
         vTxt = "EIGHTEEN "
       Case 19
         vTxt = "NINETEEN "
       Case Else
          Select Case Val(Left(psNum, 1))
            Case 2
                vTxt = "TWENTY "
            Case 3
                vTxt = "THIRTY "
            Case 4
                vTxt = "FORTY "
            Case 5
                vTxt = "FIFTY "
            Case 6
                vTxt = "SIXTY "
            Case 7
                vTxt = "SEVENTY "
            Case 8
                vTxt = "EIGHTY "
            Case 9
                vTxt = "NINETY "
          End Select
          
          x = Val(Right(psNum, 1))
          vTxt = vTxt & SpellNum(x)
          x = 0
    End Select

Case 3
    x = 2
    vTxt = psNum
    vWord = "HUNDRED "


Case 4, 5, 6
    x = 3
    vWord = "THOUSAND "


Case 7, 8, 9
    x = 6
    vWord = "MILLION "


Case 10, 11, 12
    x = 9
    vWord = "BILLION "
End Select


If x > 0 Then
    l = Len(psNum) - x
    vN1 = Left(psNum, l)
    vN2 = Mid(psNum, l + 1)
    vTxt = SpellNum(vN1) & vWord
    vTxt = vTxt & SpellNum(vN2)
End If


If Len(vCents) > 0 Then
   SpellNum = vTxt & " and " & vCents & " cents"
Else
   SpellNum = vTxt
End If
End Function
 
Upvote 0
Still doesnt round instead I get " fourteen and seventy seventy five cents" from 14.775

I want it to turn out like "fourteen dollars and seventy eight cents"

Thanks for trying tho
 
Upvote 0
how about researching round or roundup to two decimals that way you should get what you seek, just convert the output before converting
 
Upvote 0
What if you change
Code:
MyNumber = Trim(Str(MyNumber))

to
Code:
MyNumber = Trim(Str(Round(MyNumber,2)))
 
Upvote 0
My issue is instead of writing the number in a cell that I want spelled in english i need it to spell a answer to a formula... So while it rounds the number for the formula to make it a currency ie. 14.775 = $14.78 it spells out "fourteen dollars and seventy seven cents" I need it to round like the number does to say "fourteen dollars and seventy eight cents

Is there anyway i can modify the module above to do this?
You could pass the value rounded to two decimal places to the function; for example...

=SpellNumber(ROUND(A1,2))

or, alternately, change this line of code...

MyNumber = Trim(Str(MyNumber))

to this...

MyNumber = Trim(Str(Round(MyNumber, 2)))
 
Upvote 0
The original code (before any suggestions were made) was posted in Message #1. I would note this thread is some 6 years old so I doubt the original poster is still following it.
 
Upvote 0

Forum statistics

Threads
1,223,277
Messages
6,171,156
Members
452,385
Latest member
Dottj

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