Total in Money Converted into Letters!!!

E

Edgar

Hi All,
My Excel program has a TOTAL at the end of all the Items
sold. But on the bottom of that, I have to fill in everytime
in letters of what the TOTAL gives me. Is there any way
to make that happen by itself?

Exp. TOTAL is $900.00
On the other line, I have to fill in:
Nine Hundred Dollars and 00/100
and I do a lot of this and sometimes
I dont write the exact amount, so I
want to know if anybody knows of a
better way to do this. Thank You.
 
U

ufo_pilot

1. Start Microsoft Excel.
2. Press ALT+F11 to start the Visual Basic Editor.
3. On the Insert menu, click Module.
4. Copy & paste the following code into the module sheet.

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
 
E

Edgar

ok. I have the CODE. now I put it in and nothing happens with that cell.
Do I have to click the cell where I want this info to go? but how is it
going to know what to convert to Text?
Thank You...
 
B

bplumhoff

Hello Edgar,

Copy the code. Press ALT + F11. Insert a module. Paste the code.
Go back to Excel spreadsheet. Enter
=spellnumber(a1)
for example.

HTH,
Bernd
 
G

Gord Dibben

The code is to be pasted into a General Module in your workbook.

The.............Say you have 123.33 in A1

In B1 enter =SpellNumber(A1)


Gord Dibben MS Excel MVP
 
E

Edgar

Got it !!!

Now, the amount right now is $1,583.00 <--- this is exactly how it reads.
and the letter amount says:
One Thousand FiveHundredandeightythree Dollars and Zero Cents.
is there any ways to make it separate by itself? like:
One Thousand Five Hundred and eighty three Dollars and Zero Cents.
This will help a lot.
It seems everytime the numbers are together, it will too make the
letters go together. Let me know, and thank you for all your guys help.
 
B

bplumhoff

Hi Edgar,

I intentionally programmed it this way and changed the code which was
published in the web.

Have a look at the other suggestions and compare, please.

Regards,
Bernd
 
E

Edgar

Thank You Bernd.

I went back to your website and copy and pasted the code again,
this is what i did.
I copy the code.
went back to EXCEL and clicked ALT+F11
and I replace the CODE there with the new one I copy from you site.
Nothing different happen. Did I forgot to do something?
 
B

bplumhoff

Hi Edgar,

Sorry for this misunderstanding. I changed the original "MS" code and
created the one which you can see at my website.

If you want to split the words you might feel tempted to use the
original code without detailed error checking.

Regards,
Bernd
 
B

bplumhoff

Hello,

This never happened to me.

Does this happen on other computers as well?

If yes send me your file so that I can have a look at your application.

Regards,
Bernd
 
Top