Solved

How do I modify =spellnumber(a1)

Posted on 2011-09-22
12
334 Views
Last Modified: 2012-06-27
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".

Thanks in advance

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
Comment
Question by:Muskett
  • 8
  • 4
12 Comments
 
LVL 32

Expert Comment

by:Rob Henson
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

Open in new window


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

Open in new window


Regards
Rob H
0
 
LVL 32

Expert Comment

by:Rob Henson
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 32

Expert Comment

by:Rob Henson
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
Gigs: Get Your Project Delivered by an Expert

Select from freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely and get projects done right.

 
LVL 32

Expert Comment

by:Rob Henson
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))

Open in new window

to

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

Open in new window


Thanks
Rob H
0
 
LVL 32

Expert Comment

by:Rob Henson
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

by:Muskett
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 32

Accepted Solution

by:
Rob Henson earned 250 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

Open in new window


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

by:Muskett
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 32

Expert Comment

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

Thanks
Rob H
0
 

Author Comment

by:Muskett
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 32

Expert Comment

by:Rob Henson
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

by:Muskett
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

Live: Real-Time Solutions, Start Here

Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.

Question has a verified solution.

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

A little background as to how I came to I design this code: Around 5 years ago I designed an add-in that formatted Excel files to a corporate standard, applying different cell colours and font type depending on whether the cells contained inputs,…
Approximate matching with VLOOKUP and MATCH seems to me to be a greatly under-used technique, and one which is vital for getting good performance out of large lookups. Until recently I would always have advised using an exact match for simplicity an…
The view will learn how to download and install SIMTOOLS and FORMLIST into Excel, how to use SIMTOOLS to generate a Monte Carlo simulation of 30 sales calls, and how to calculate the conditional probability based on the results of the Monte Carlo …
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…

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

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

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now