Solved

# How do I modify =spellnumber(a1)

Posted on 2011-09-22
Medium Priority
380 Views
Hi,
I am British and want to change the following Microsoft code to pounds and pence.
I have successfully done that but I would like the "pence" to be in the format:
56p

so,
Three Pounds and 56p
Note the trailing "p".

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 "
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")
' Convert cents and set MyNumber to dollar amount.
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

' Converts a number from 100-999 into text
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

' Converts a number from 10 to 99 into text.
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

' Converts a number from 1 to 9 into text.
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
0
Question by:Muskett
• 8
• 4

LVL 34

Expert Comment

ID: 36581316
Note this block of code towards the end of the function:

``````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
``````

Change to:

``````Select Case Pounds
Case ""
Pounds = "No Pounds"
Case "One"
Pounds = "One Pound"
Case Else
Pounds = Pounds & " Pounds"
End Select
Select Case Pence
Case ""
Pence = " and No Pence"
Case "One"
Pence = " and 1p"
Case Else
Pence = " and " & Pence & "p"
End Select
SpellNumber = Pounds & Pence
``````

Regards
Rob H
0

LVL 34

Expert Comment

ID: 36581342
Sorry, there were other conversions required.

Basically, where there was the word dollars or cents I replaced with Pounds and pence. With the calculated variables it wouldn't matter so long as they were consistent throughout the function but in the text strings it would have the desired effect.

Thanks
Rob H
0

LVL 34

Expert Comment

ID: 36581377
Not quite as simple as that!! :-(

52.4 = Fifty Two pounds and Forty p

Presumably you would want:

Fifty Two pounds and 40p

I will keep looking!

Rob H
0

LVL 34

Expert Comment

ID: 36581483
Sorted:

Assuming having already done a Find Replace for Cents with Pence

Line 15 of code change:

``````Pence = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00", 2))
``````
to

``````Pence = Round(MyNumber - Int(MyNumber), 2) * 100
``````

Thanks
Rob H
0

LVL 34

Expert Comment

ID: 36581553
Being totally British would you want for example 1152.35 to be "One thousand, one hundred and fifty two" ie with the comma after thousand and the and between the hundreds and tens.

If so, a couple more changes required:

Lines 5 to 8 become

Place(2) = " Thousand, "
Place(3) = " Million, "
Place(4) = " Billion, "
Place(5) = " Trillion, "

In the GetHundreds function lione 6 becomes:

Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred and "

Doesn't work when no hundreds eg 1052.52

Thanks
Rob H
0

Author Comment

ID: 36585170
RobH,

many thanks, will test during the day.

I don't think the and 52p is necessary

But if we want to be totally grammatically correct, we should have:
1,402.31 as
one thousand four hundred and two pounds 52p

I guess that is really complicating things as the code would need to be clever enough to differentiate between the above example and

1,432.31
giving
One Thousand four hundred and thirty two pounds 31p

Perhaps the and works after the "hundred" so the code changes to "hundred and"
But the complication is if there are no hundreds,

1,002.31

This could turn into a coding nightmare I feel!

If the initial question is answered and works, the 52p bit, then I will award points and raise a new question, what do you think?

Thanks for your work,
David
0

LVL 34

Accepted Solution

Rob Henson earned 1000 total points
ID: 36585810
Hi David,

Final version:

``````Option Explicit
'Main Function
Function SpellNumber(ByVal MyNumber)
Dim Pounds, Pence, Temp
Dim DecimalPlace, Count
ReDim Place(9) As String
Place(2) = " Thousand "
Place(3) = " Million "
Place(4) = " Billion "
Place(5) = " Trillion "
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")
' Convert Pence and set MyNumber to Pound amount.
If DecimalPlace > 0 Then
Pence = Round(MyNumber - Int(MyNumber), 2) * 100
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
'    Stop
Count = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then Pounds = Temp & Place(Count) & Pounds
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Pounds
Case ""
Pounds = "No Pounds"
Case "One"
Pounds = "One Pound"
Case Else
Pounds = Pounds & " Pounds"
End Select
Select Case Pence
Case ""
Pence = " and No Pence"
Case "One"
Pence = " and 1p"
Case Else
Pence = " and " & Pence & "p"
End Select
SpellNumber = Pounds & Pence
End Function

' Converts a number from 100-999 into text
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 and "
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

' Converts a number from 10 to 99 into text.
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

' Converts a number from 1 to 9 into text.
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
``````

Converts:

All digits eg 1115.52 = One Thousand One Hundred and Fifteen Pounds and 52p

No Tens eg 1105.52 = One Thousand One Hundred and Five Pounds and 52p

No hundreds eg 1015.52 = One Thousand Fifteen Pounds and 52p

No hundreds or tens eg 1005.52 = One Thousand Five Pounds and 52p

No hundreds or tens or digits = 1000.52 = One Thousand  Pounds and 52p

Hope this helps!

Thanks
Rob H
0

Author Closing Comment

ID: 36585851
Not being a coder I am impressed with the way the question was interpreted and answered.

Points happily and gratefully awarded.

Many thanks,
0

LVL 34

Expert Comment

ID: 36586082
Glad to be of help, I am always learning from EE as well.

Thanks
Rob H
0

Author Comment

ID: 36586144
Am having inconsistency in making it work on all workbooks.

tested on new book perfect, then tried on existing WB, the place I need it and then it gives a #NAME? error.

will check if I am doing something stupid and may have to get back to you on Monday.

thanks
0

LVL 34

Expert Comment

ID: 36586317
The code will need to be copied into a module in the existing workbook as well.

Do you have other macros in the existing workbook?

Thanks
Rob H

0

Author Comment

ID: 36586488
No, checked that. no other code or macro's.

For sure, its my fault as it worked on a clean book.

Will revert.

THanks
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
How to get Spreadsheet Compare 2016 working with the 64 bit version of Office 2016
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custoâ€¦
###### Suggested Courses
Course of the Month12 days, 23 hours left to enroll

#### 579 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.