Spellnumber - USD/AFa

[Guest]

Hi masters,
I would like to use spellnumber in my worksheet. I want that if I put $200
using currency format in one cell it should give me Two Hundred US Dollars
and No Cents and if I put AFA 200 using currency format it should be able to
return Two Hundred AFA in another cell. I have found the following link to
put in VBA code but some time this is also not working.
http://www.microsoft.com/office/com...5298&catlist=&dglist=&ptlist=&exp=&sloc=en-us

Is there any one who can help me, thanks.

Daoud Fakhry

 

[Guest]

Hi Daoud
This will do the trick.
I believe it came from one of JE McGimpseys books, but my apologies to the
author, if it didn't.
After placing the code in your sheet, all you have to do is use the formula
=SPELLDOLLARS(A1) If your data is in A1

Regards
Michael M

Function SPELLDOLLARS(cell) As Variant
' Spelldollars Macro
' Macro recorded 24/12/2004
Dim Dollars As String
Dim Cents As String
Dim TextLen As Integer
Dim Temp As String
Dim Pos As Integer
Dim iHundreds As Integer
Dim iTens As Integer
Dim iOnes As Integer
Dim Units(2 To 5) As String
Dim bHit As Boolean
Dim Ones As Variant
Dim Teens As Variant
Dim Tens As Variant
Dim NegFlag As Boolean

' Is it a non-number?
If Not IsNumeric(cell) Then
SPELLDOLLARS = "This is not a numeric value, please try again!!"
'CVErr(xlErrValue)
Exit Function
End If

' Is it negative?
If cell < 0 Then
NegFlag = True
cell = Abs(cell)
End If

Dollars = Format(cell, "###0.00")
TextLen = Len(Dollars) - 3

' Is it too large?
If TextLen > 15 Then
SPELLDOLLARS = "This number is too large to print, please try again"
'CVErr(xlErrNum)
Exit Function
End If

' Do the cents part
Cents = Right(Dollars, 2) & " cents"
If cell < 1 Then
SPELLDOLLARS = Cents
Exit Function
End If

Dollars = Left(Dollars, TextLen)

Ones = Array("", "One", "Two", "Three", "Four", "Five", "Six", "Seven",
"Eight", "Nine")
Teens = Array("Ten", "Eleven", "Twelve", "Thirteen", "Fourteen",
"Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen")
Tens = Array("", "", "Twenty", "Thirty", "Forty", "Fifty", "Sixty",
"Seventy", "Eighty", "Ninety")

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

Temp = ""

For Pos = 15 To 3 Step -3
If TextLen >= Pos - 2 Then
bHit = False
If TextLen >= Pos Then
iHundreds = Asc(Mid$(Dollars, TextLen - Pos + 1, 1)) - 48
If iHundreds > 0 Then
Temp = Temp & "" & Ones(iHundreds) & " Hundred and"
bHit = True
End If
End If
iTens = 0
iOnes = 0

If TextLen >= Pos - 1 Then
iTens = Asc(Mid$(Dollars, TextLen - Pos + 2, 1)) - 48
End If

If TextLen >= Pos - 2 Then
iOnes = Asc(Mid$(Dollars, TextLen - Pos + 3, 1)) - 48
End If

If iTens = 1 Then
Temp = Temp & " " & Teens(iOnes)
bHit = True
Else
If iTens >= 2 Then
Temp = Temp & " " & Tens(iTens)
bHit = True
End If
If iOnes > 0 Then
If iTens >= 2 Then
Temp = Temp & "-"
Else
Temp = Temp & " "
End If
Temp = Temp & Ones(iOnes)
bHit = True
End If
End If
If bHit And Pos > 3 Then
Temp = Temp & "" & Units(Pos \ 3)
End If
End If
Next Pos

SPELLDOLLARS = Trim(Temp) & " Dollars and " & Cents
If NegFlag Then SPELLDOLLARS = "(" & SPELLDOLLARS & ")"

End Function

 

[Guest]

Dear Michael,
Thanks for your reply, but I use 2 currencies at the same time. Let's assume
I have my digits in A1 and I want to return the word in A2. If I change the
currency of A1 to $ the word should be changed to Dollars and if I change the
currency to AFA it should return me AFA. Please let me know if you get my
point.

Regards,
Daoud Fakhry

 

[Bernie Deitrick]

Daoud ,

Try changing this line in the function:

SPELLDOLLARS = Trim(Temp) & " Dollars and " & Cents

to this:

SPELLDOLLARS = Trim(Temp) & IIf(InStr(1, myCell.NumberFormat, "$#") > 0, " Dollars and ", " AFA and
")
& Cents

The part $# is from the numberformat for the standard dollar formatting - your formatting may
differ, so to find a usable stringf, format your cell for $, then run this macro:

Sub test()
MsgBox ActiveCell.NumberFormat
End Sub


Note the format string that is returned. Then format for AFA and run it again. Pick out a unique
combination of characters that appears in the $ format and not the AFA format, and insert it in
place of the $# (which may work anyway).

Note that reformatting the cell will not cause the SPELLDOLLARS function to recalc, so you may need
to force a recalc.

HTH,
Bernie
MS Excel MVP

 

[Guest]

Dear Barnie,
I have the functions according to your advice but it returns #VALUE!, please
explain on how should I go through these steps to solve my problem. FYI, it
doesn't work for both USD and AFA format.

Thanks,

 

[Rick Rothstein \(MVP - VB\)]

Can you clarify something for us? As I see it, you want the formula to
examine the contents of A1 and decide if you are working in US Dollars or in
AFAs. Okay, show us samples of the type of entries that could be in A1 (make
them amounts that show full and fraction parts of the currency). I looked up
AFA on line... is that the Afghanistan Afghani? If so, it looked like
fractional amounts of that currency are reported in decimal amounts only.
For example, it is my assumption that whereas $123.45 would be written as
One Hundred Twenty Three US Dollars and Forty Five Cents, 123.45 AFA would
be written as One Hundred Twenty Three Point Four Five AFAs... is that
anywhere near correct? If not, please explain what the final format should
look like also. Remember, it is hard to give you what you want if we don't
know what it should look like. The more detail you give us about the
process, the faster we can give you a solution.

Rick

 

[Guest]

Dear Rick,
Actually we have disbursement vouchers which we put the amount in number and
I need the words in the next cell. AFA is standing for Afghanistan Afghani
and we don't use fractions in our AFA inputs, but for USD sometimes we have
fraction amounts. Our inputs are very sample which is the amount we pay to
our clients. Please let me know if you need further clarification. You can
set the fractions to show like the following:

$145.23 One Hundred Forty Five US Dollars and 23/100

AFA 145.23 One Hundred Forty Five Afghani and 23/100

I think the above example will help you.

Thanks, Daoud Fakhry

 

[Rick Rothstein \(MVP - VB\)]

Actually we have disbursement vouchers which we put the amount in number

and
I need the words in the next cell. AFA is standing for Afghanistan Afghani
and we don't use fractions in our AFA inputs, but for USD sometimes we
have
fraction amounts. Our inputs are very sample which is the amount we pay to
our clients. Please let me know if you need further clarification. You can
set the fractions to show like the following:

$145.23 One Hundred Forty Five US Dollars and 23/100

AFA 145.23 One Hundred Forty Five Afghani and 23/100

I think the above example will help you.

Okay, I have modified a "number to text" routine I wrote several years ago
to make it output what you have asked for. If you try and examine the code,
you will find a **LOT** of statements in there that are "dead" because all I
did was short-circuit them and patched in what was necessary to make it work
with the functionality you requested (sorry, I didn't have the time or
inclination to remove all of the now dead code). By the way, the capability
of this function may be overkill for the size of the numbers you probably
will be dealing with... it can handle numbers up to one less than a
quintillion; however, note that you will have to pass such really large
numbers (15 digits or more) in as Text values... otherwise VB will convert
the large non-Text values to Doubles (which will destroy the conversion)

Okay, with that out of the way, Here is how to implement the function... Go
into the VB Editor (Alt+F11) and add a Module to the Workbook (Insert/Module
from the VBA menu) and then paste in all of the code appearing after my
signature into the Module's code window. There is an Optional argument that
controls which money unit text to use. It is named UseDollars and defaulted
to False. That means, if you simply pass in a number, that number will be
assumed to be Afghani (which is what will be assumed if you specify False
for the optional argument). If you pass in True for the second argument,
then the number passed in will be assumed to be US Dollars.

I was still unsure of how the numbers are listed in your cells, so you may
have to do some string parsing if your dollar sign and/or AFA designation is
in the cell with the number... the function only wants a number for its
first argument. So, if the dollar sign and/or AFA designation is in the
cell, you will have to remove it. OR, you can post back and tell me exactly
what your cells have in them (text, currency formatting, some other
formatting, whatever) and I will modify the code to account for them. Okay,
assuming the number (without any $ or AFA) is A1, then you would use
=DollarsAFA(A1) to convert the number in A1 to Afghani text, and
=DollarsAFA(A1,TRUE) to convert it to US Dollars text. Try it out (in a
new/blank worksheet for testing purposes) and let me know what you think

Rick

Private sNumberText() As String

'-----------------------------------------
' Modified July 16, 2007
' Modified function name for Excel request
' Original optional argument removed, new
' optional argument for Dollars/AFA added
'-----------------------------------------
Public Function DollarsAFA(NumberIn As Variant, Optional _
UseDollars As Boolean = False) As String
Dim cnt As Long
Dim DecimalPoint As Long
Dim CardinalNumber As Long
Dim CommaAdjuster As Long
Dim TestValue As Long
Dim CurrValue As Currency
Dim CentsString As String
Dim NumberSign As String
Dim WholePart As String
Dim BigWholePart As String
Dim DecimalPart As String
Dim MoneyUnits As String
Dim tmp As String
Dim sStyle As String
Dim bUseAnd As Boolean
Dim bUseCheck As Boolean
Dim bUseDollars As Boolean
'-----------------------------------------
' Added July 16, 2007
' Original optional argument removed, new
' optional argument for Dollars/AFA added
'-----------------------------------------
If UseDollars Then
MoneyUnits = "US Dollars "
Else
MoneyUnits = "Afghani "
End If
'----------------------------------------
' Begin setting conditions for formatting
'----------------------------------------
' Determine whether to apply special formatting.
' If nothing passed, return routine result
' converted only into its numeric equivalents,
' with no additional format text.
'' sStyle = LCase(AND_or_CHECK_or_DOLLAR)
' User passed "AND": "and" will be added
' between hundredths and tens of dollars,
' ie "Three Hundred and Forty Two"
'' bUseAnd = sStyle = "and"
' User passed "DOLLAR": "dollar(s)" and "cents"
' appended to string,
' ie "Three Hundred and Forty Two Dollars"
'' bUseDollars = sStyle = "dollar"
' User passed "CHECK" *or* "DOLLAR"
' If "check", cent amount returned as a fraction /100
' i.e. "Three Hundred Forty Two and 00/100"
' If "dollar" was passed, "dollar(s)" and "cents"
' Appended instead.
'-----------------------------------------
' Modified July 16, 2007
' Old optional arguments for sStyle remove
' and defaulted to bUseCheck
'-----------------------------------------
sStyle = "check"
bUseCheck = (sStyle = "check") Or (sStyle = "dollar")
'----------------------------------------
' Check/create array. If this is the first
' time using this routine, create the text
' strings that will be used.
'----------------------------------------
If Not IsBounded(sNumberText) Then
Call BuildArray(sNumberText)
End If
'----------------------------------------
' Begin validating the number, and breaking
' into constituent parts
'----------------------------------------
' Prepare to check for valid value in
NumberIn = Trim$(NumberIn)
If Not IsNumeric(NumberIn) Then
' Invalid entry - abort
DollarsAFA = "Error - Number improperly formed"
Exit Function
Else
' Decimal check
DecimalPoint = InStr(NumberIn, ".")
If DecimalPoint > 0 Then
' Split the fractional and primary numbers
DecimalPart = Mid$(NumberIn, DecimalPoint + 1)
WholePart = Left$(NumberIn, DecimalPoint - 1)
Else
' Assume the decimal is the last char
DecimalPoint = Len(NumberIn) + 1
WholePart = NumberIn
End If
If InStr(NumberIn, ",,") Or _
InStr(NumberIn, ",.") Or _
InStr(NumberIn, ".,") Or _
InStr(DecimalPart, ",") Then
DollarsAFA = "Error - Improper use of commas"
Exit Function
ElseIf InStr(NumberIn, ",") Then
CommaAdjuster = 0
WholePart = ""
For cnt = DecimalPoint - 1 To 1 Step -1
If Not Mid$(NumberIn, cnt, 1) Like "[,]" Then
WholePart = Mid$(NumberIn, cnt, 1) & WholePart
Else
CommaAdjuster = CommaAdjuster + 1
If (DecimalPoint - cnt - CommaAdjuster) Mod 3 Then
DollarsAFA = "Error - Improper use of commas"
Exit Function
End If
End If
Next
End If
End If
If Left$(WholePart, 1) Like "[+-]" Then
NumberSign = IIf(Left$(WholePart, 1) = "-", "Minus ", "Plus ")
WholePart = Mid$(WholePart, 2)
End If
'----------------------------------------
' Begin code to assure decimal portion of
' check value is not inadvertently rounded
'----------------------------------------
If bUseCheck = True Then
CurrValue = CCur(Val("." & DecimalPart))
DecimalPart = Mid$(Format$(CurrValue, "0.00"), 3, 2)
If CurrValue >= 0.995 Then
If WholePart = String$(Len(WholePart), "9") Then
WholePart = "1" & String$(Len(WholePart), "0")
Else
For cnt = Len(WholePart) To 1 Step -1
If Mid$(WholePart, cnt, 1) = "9" Then
Mid$(WholePart, cnt, 1) = "0"
Else
Mid$(WholePart, cnt, 1) = _
CStr(Val(Mid$(WholePart, cnt, 1)) + 1)
Exit For
End If
Next
End If
End If
End If
'----------------------------------------
' Final prep step - this assures number
' within range of formatting code below
'----------------------------------------
If Len(WholePart) > 9 Then
BigWholePart = Left$(WholePart, Len(WholePart) - 9)
WholePart = Right$(WholePart, 9)
End If
If Len(BigWholePart) > 9 Then
DollarsAFA = "Error - Number too large"
Exit Function
ElseIf Not WholePart Like String$(Len(WholePart), "#") Or _
(Not BigWholePart Like String$(Len(BigWholePart), "#") _
And Len(BigWholePart) > 0) Then
DollarsAFA = "Error - Number improperly formed"
Exit Function
End If
'----------------------------------------
' Begin creating the output string
'----------------------------------------
' Very Large values
TestValue = Val(BigWholePart)
If TestValue > 999999 Then
CardinalNumber = TestValue \ 1000000
tmp = HundredsTensUnits(CardinalNumber) & "Quadrillion "
TestValue = TestValue - (CardinalNumber * 1000000)
End If
If TestValue > 999 Then
CardinalNumber = TestValue \ 1000
tmp = tmp & HundredsTensUnits(CardinalNumber) & "Trillion "
TestValue = TestValue - (CardinalNumber * 1000)
End If
If TestValue > 0 Then
tmp = tmp & HundredsTensUnits(TestValue) & "Billion "
End If
' Lesser values
TestValue = Val(WholePart)
If TestValue = 0 And BigWholePart = "" Then tmp = "Zero "
If TestValue > 999999 Then
CardinalNumber = TestValue \ 1000000
tmp = tmp & HundredsTensUnits(CardinalNumber) & "Million "
TestValue = TestValue - (CardinalNumber * 1000000)
End If
If TestValue > 999 Then
CardinalNumber = TestValue \ 1000
tmp = tmp & HundredsTensUnits(CardinalNumber) & "Thousand "
TestValue = TestValue - (CardinalNumber * 1000)
End If
If TestValue > 0 Then
If Val(WholePart) < 99 And BigWholePart = "" Then bUseAnd = False
tmp = tmp & HundredsTensUnits(TestValue, bUseAnd)
End If
' If in dollar mode, assure the text is the correct plurality
If bUseDollars = True Then
CentsString = HundredsTensUnits(DecimalPart)
If tmp = "One " Then
tmp = tmp & "Dollar"
Else
tmp = tmp & "Dollars"
End If
If Len(CentsString) > 0 Then
tmp = tmp & " and " & CentsString
If CentsString = "One " Then
tmp = tmp & "Cent"
Else
tmp = tmp & "Cents"
End If
End If
ElseIf bUseCheck = True Then
'-----------------------------------------
' Modified July 16, 2007
' New money units text spliced in
'-----------------------------------------
tmp = tmp & MoneyUnits & "and " & Left$(DecimalPart & "00", 2)
tmp = tmp & "/100"
Else
If Len(DecimalPart) > 0 Then
tmp = tmp & "Point"
For cnt = 1 To Len(DecimalPart)
tmp = tmp & " " & sNumberText(Mid$(DecimalPart, cnt, 1))
Next
End If
End If
' Done!
DollarsAFA = NumberSign & tmp
End Function

Private Sub BuildArray(sNumberText() As String)
ReDim sNumberText(0 To 27) As String
sNumberText(0) = "Zero"
sNumberText(1) = "One"
sNumberText(2) = "Two"
sNumberText(3) = "Three"
sNumberText(4) = "Four"
sNumberText(5) = "Five"
sNumberText(6) = "Six"
sNumberText(7) = "Seven"
sNumberText(8) = "Eight"
sNumberText(9) = "Nine"
sNumberText(10) = "Ten"
sNumberText(11) = "Eleven"
sNumberText(12) = "Twelve"
sNumberText(13) = "Thirteen"
sNumberText(14) = "Fourteen"
sNumberText(15) = "Fifteen"
sNumberText(16) = "Sixteen"
sNumberText(17) = "Seventeen"
sNumberText(18) = "Eighteen"
sNumberText(19) = "Nineteen"
sNumberText(20) = "Twenty"
sNumberText(21) = "Thirty"
sNumberText(22) = "Forty"
sNumberText(23) = "Fifty"
sNumberText(24) = "Sixty"
sNumberText(25) = "Seventy"
sNumberText(26) = "Eighty"
sNumberText(27) = "Ninety"
End Sub

Private Function IsBounded(vntArray As Variant) As Boolean
' Note: the application in the IDE will stop
' at this line when first run if the IDE error
' mode is not set to "Break on Unhandled Errors"
' (Tools/Options/General/Error Trapping)
On Error Resume Next
IsBounded = IsNumeric(UBound(vntArray))
End Function

Private Function HundredsTensUnits(ByVal TestValue As Integer, _
Optional bUseAnd As Boolean) As String
Dim CardinalNumber As Integer
If TestValue > 99 Then
CardinalNumber = TestValue \ 100
HundredsTensUnits = sNumberText(CardinalNumber) & " Hundred "
TestValue = TestValue - (CardinalNumber * 100)
End If
If bUseAnd = True Then
HundredsTensUnits = HundredsTensUnits & "and "
End If
If TestValue > 20 Then
CardinalNumber = TestValue \ 10
HundredsTensUnits = HundredsTensUnits & _
sNumberText(CardinalNumber + 18) & " "
TestValue = TestValue - (CardinalNumber * 10)
End If
If TestValue > 0 Then
HundredsTensUnits = HundredsTensUnits & _
sNumberText(TestValue) & " "
End If
End Function

 

[Guest]

Dear Rick,
Thanks for your all efforts on getting this for me. Your functions works
perfectly for me and I can say that you are really a super master. but still
I have the following issue:

I only use one cell as a variable for my amounts, for example if I pay
$5,000 I use the currency format of $ and if I pay AFA 5,000 I select AFA
from the drop down list in currency format. So if I continue working this way
then I need to change the formula each time I pay in different currencies. Is
it possible for you to add more functions so by using one formula it should
work for both currencies with thier own format, thanks.

Daoud

Actually we have disbursement vouchers which we put the amount in number
and
I need the words in the next cell. AFA is standing for Afghanistan Afghani
and we don't use fractions in our AFA inputs, but for USD sometimes we
have
fraction amounts. Our inputs are very sample which is the amount we pay to
our clients. Please let me know if you need further clarification. You can
set the fractions to show like the following:

$145.23 One Hundred Forty Five US Dollars and 23/100

AFA 145.23 One Hundred Forty Five Afghani and 23/100

I think the above example will help you.

Okay, I have modified a "number to text" routine I wrote several years ago
to make it output what you have asked for. If you try and examine the code,
you will find a **LOT** of statements in there that are "dead" because all I
did was short-circuit them and patched in what was necessary to make it work
with the functionality you requested (sorry, I didn't have the time or
inclination to remove all of the now dead code). By the way, the capability
of this function may be overkill for the size of the numbers you probably
will be dealing with... it can handle numbers up to one less than a
quintillion; however, note that you will have to pass such really large
numbers (15 digits or more) in as Text values... otherwise VB will convert
the large non-Text values to Doubles (which will destroy the conversion)

Okay, with that out of the way, Here is how to implement the function... Go
into the VB Editor (Alt+F11) and add a Module to the Workbook (Insert/Module
from the VBA menu) and then paste in all of the code appearing after my
signature into the Module's code window. There is an Optional argument that
controls which money unit text to use. It is named UseDollars and defaulted
to False. That means, if you simply pass in a number, that number will be
assumed to be Afghani (which is what will be assumed if you specify False
for the optional argument). If you pass in True for the second argument,
then the number passed in will be assumed to be US Dollars.

I was still unsure of how the numbers are listed in your cells, so you may
have to do some string parsing if your dollar sign and/or AFA designation is
in the cell with the number... the function only wants a number for its
first argument. So, if the dollar sign and/or AFA designation is in the
cell, you will have to remove it. OR, you can post back and tell me exactly
what your cells have in them (text, currency formatting, some other
formatting, whatever) and I will modify the code to account for them. Okay,
assuming the number (without any $ or AFA) is A1, then you would use
=DollarsAFA(A1) to convert the number in A1 to Afghani text, and
=DollarsAFA(A1,TRUE) to convert it to US Dollars text. Try it out (in a
new/blank worksheet for testing purposes) and let me know what you think

Rick

Private sNumberText() As String

'-----------------------------------------
' Modified July 16, 2007
' Modified function name for Excel request
' Original optional argument removed, new
' optional argument for Dollars/AFA added
'-----------------------------------------
Public Function DollarsAFA(NumberIn As Variant, Optional _
UseDollars As Boolean = False) As String
Dim cnt As Long
Dim DecimalPoint As Long
Dim CardinalNumber As Long
Dim CommaAdjuster As Long
Dim TestValue As Long
Dim CurrValue As Currency
Dim CentsString As String
Dim NumberSign As String
Dim WholePart As String
Dim BigWholePart As String
Dim DecimalPart As String
Dim MoneyUnits As String
Dim tmp As String
Dim sStyle As String
Dim bUseAnd As Boolean
Dim bUseCheck As Boolean
Dim bUseDollars As Boolean
'-----------------------------------------
' Added July 16, 2007
' Original optional argument removed, new
' optional argument for Dollars/AFA added
'-----------------------------------------
If UseDollars Then
MoneyUnits = "US Dollars "
Else
MoneyUnits = "Afghani "
End If
'----------------------------------------
' Begin setting conditions for formatting
'----------------------------------------
' Determine whether to apply special formatting.
' If nothing passed, return routine result
' converted only into its numeric equivalents,
' with no additional format text.
'' sStyle = LCase(AND_or_CHECK_or_DOLLAR)
' User passed "AND": "and" will be added
' between hundredths and tens of dollars,
' ie "Three Hundred and Forty Two"
'' bUseAnd = sStyle = "and"
' User passed "DOLLAR": "dollar(s)" and "cents"
' appended to string,
' ie "Three Hundred and Forty Two Dollars"
'' bUseDollars = sStyle = "dollar"
' User passed "CHECK" *or* "DOLLAR"
' If "check", cent amount returned as a fraction /100
' i.e. "Three Hundred Forty Two and 00/100"
' If "dollar" was passed, "dollar(s)" and "cents"
' Appended instead.
'-----------------------------------------
' Modified July 16, 2007
' Old optional arguments for sStyle remove
' and defaulted to bUseCheck
'-----------------------------------------
sStyle = "check"
bUseCheck = (sStyle = "check") Or (sStyle = "dollar")
'----------------------------------------
' Check/create array. If this is the first
' time using this routine, create the text
' strings that will be used.
'----------------------------------------
If Not IsBounded(sNumberText) Then
Call BuildArray(sNumberText)
End If
'----------------------------------------
' Begin validating the number, and breaking
' into constituent parts
'----------------------------------------
' Prepare to check for valid value in
NumberIn = Trim$(NumberIn)
If Not IsNumeric(NumberIn) Then
' Invalid entry - abort
DollarsAFA = "Error - Number improperly formed"
Exit Function
Else
' Decimal check
DecimalPoint = InStr(NumberIn, ".")
If DecimalPoint > 0 Then
' Split the fractional and primary numbers
DecimalPart = Mid$(NumberIn, DecimalPoint + 1)
WholePart = Left$(NumberIn, DecimalPoint - 1)
Else
' Assume the decimal is the last char
DecimalPoint = Len(NumberIn) + 1
WholePart = NumberIn
End If
If InStr(NumberIn, ",,") Or _
InStr(NumberIn, ",.") Or _
InStr(NumberIn, ".,") Or _
InStr(DecimalPart, ",") Then
DollarsAFA = "Error - Improper use of commas"
Exit Function
ElseIf InStr(NumberIn, ",") Then
CommaAdjuster = 0
WholePart = ""
For cnt = DecimalPoint - 1 To 1 Step -1
If Not Mid$(NumberIn, cnt, 1) Like "[,]" Then
WholePart = Mid$(NumberIn, cnt, 1) & WholePart
Else
CommaAdjuster = CommaAdjuster + 1
If (DecimalPoint - cnt - CommaAdjuster) Mod 3 Then
DollarsAFA = "Error - Improper use of commas"
Exit Function
End If
End If
Next
End If
End If
If Left$(WholePart, 1) Like "[+-]" Then
NumberSign = IIf(Left$(WholePart, 1) = "-", "Minus ", "Plus ")
WholePart = Mid$(WholePart, 2)
End If
'----------------------------------------
' Begin code to assure decimal portion of
' check value is not inadvertently rounded
'----------------------------------------
If bUseCheck = True Then
CurrValue = CCur(Val("." & DecimalPart))
DecimalPart = Mid$(Format$(CurrValue, "0.00"), 3, 2)
If CurrValue >= 0.995 Then
If WholePart = String$(Len(WholePart), "9") Then
WholePart = "1" & String$(Len(WholePart), "0")
Else
For cnt = Len(WholePart) To 1 Step -1
If Mid$(WholePart, cnt, 1) = "9" Then
Mid$(WholePart, cnt, 1) = "0"
Else
Mid$(WholePart, cnt, 1) = _
CStr(Val(Mid$(WholePart, cnt, 1)) + 1)
Exit For
End If
Next
End If
End If
End If
'----------------------------------------
' Final prep step - this assures number
' within range of formatting code below
'----------------------------------------
If Len(WholePart) > 9 Then
BigWholePart = Left$(WholePart, Len(WholePart) - 9)
WholePart = Right$(WholePart, 9)
End If
If Len(BigWholePart) > 9 Then
DollarsAFA = "Error - Number too large"
Exit Function
ElseIf Not WholePart Like String$(Len(WholePart), "#") Or _
(Not BigWholePart Like String$(Len(BigWholePart), "#") _
And Len(BigWholePart) > 0) Then
DollarsAFA = "Error - Number improperly formed"
Exit Function
End If
'----------------------------------------
' Begin creating the output string
'----------------------------------------
' Very Large values
TestValue = Val(BigWholePart)
If TestValue > 999999 Then
CardinalNumber = TestValue \ 1000000
tmp = HundredsTensUnits(CardinalNumber) & "Quadrillion "
TestValue = TestValue - (CardinalNumber * 1000000)
End If
If TestValue > 999 Then
CardinalNumber = TestValue \ 1000
tmp = tmp & HundredsTensUnits(CardinalNumber) & "Trillion "
TestValue = TestValue - (CardinalNumber * 1000)
End If
If TestValue > 0 Then
tmp = tmp & HundredsTensUnits(TestValue) & "Billion "
End If
' Lesser values
TestValue = Val(WholePart)
If TestValue = 0 And BigWholePart = "" Then tmp = "Zero "
If TestValue > 999999 Then
CardinalNumber = TestValue \ 1000000
tmp = tmp & HundredsTensUnits(CardinalNumber) & "Million "
TestValue = TestValue - (CardinalNumber * 1000000)
End If
If TestValue > 999 Then
CardinalNumber = TestValue \ 1000
tmp = tmp & HundredsTensUnits(CardinalNumber) & "Thousand "
TestValue = TestValue - (CardinalNumber * 1000)
End If
If TestValue > 0 Then
If Val(WholePart) < 99 And BigWholePart = "" Then bUseAnd = False
tmp = tmp & HundredsTensUnits(TestValue, bUseAnd)
End If
' If in dollar mode, assure the text is the correct plurality
If bUseDollars = True Then
CentsString = HundredsTensUnits(DecimalPart)
If tmp = "One " Then
tmp = tmp & "Dollar"
Else
tmp = tmp & "Dollars"
End If
If Len(CentsString) > 0 Then
tmp = tmp & " and " & CentsString
If CentsString = "One " Then
tmp = tmp & "Cent"
Else
tmp = tmp & "Cents"
End If
End If
ElseIf bUseCheck = True Then
'-----------------------------------------
' Modified July 16, 2007
' New money units text spliced in
'-----------------------------------------
tmp = tmp & MoneyUnits & "and " & Left$(DecimalPart & "00", 2)
tmp = tmp & "/100"
Else
If Len(DecimalPart) > 0 Then
tmp = tmp & "Point"
For cnt = 1 To Len(DecimalPart)
tmp = tmp & " " & sNumberText(Mid$(DecimalPart, cnt, 1))
Next
End If
End If
' Done!
DollarsAFA = NumberSign & tmp
End Function

Private Sub BuildArray(sNumberText() As String)
ReDim sNumberText(0 To 27) As String
sNumberText(0) = "Zero"
sNumberText(1) = "One"
sNumberText(2) = "Two"
sNumberText(3) = "Three"
sNumberText(4) = "Four"
sNumberText(5) = "Five"
sNumberText(6) = "Six"
sNumberText(7) = "Seven"
sNumberText(8) = "Eight"
sNumberText(9) = "Nine"
sNumberText(10) = "Ten"
sNumberText(11) = "Eleven"
sNumberText(12) = "Twelve"
sNumberText(13) = "Thirteen"
sNumberText(14) = "Fourteen"
sNumberText(15) = "Fifteen"

 

[Rick Rothstein \(MVP - VB\)]

Thanks for your all efforts on getting this for me. Your functions works

perfectly for me and I can say that you are really a super master. but
still
I have the following issue:

I only use one cell as a variable for my amounts, for example if I pay
$5,000 I use the currency format of $ and if I pay AFA 5,000 I select AFA
from the drop down list in currency format. So if I continue working this
way
then I need to change the formula each time I pay in different currencies.
Is
it possible for you to add more functions so by using one formula it
should
work for both currencies with thier own format, thanks.

Okay, now I see what you are doing. You are performing an individual Format
Cell operation in order to "tag" the number's currency symbol. I have
modified the code to read the assigned currency symbol information from the
cell passed into the function. (Replace all of the code you now have in the
Module that you added for my function with the code below my signature.)
However, there is a small problem with the way you are doing things, at
least as it relates to the functionality you asked for... using Format Cell
does not generate any events that are detectable in macro code. So, given
the procedure you follow, entering the number in the cell you are passing
into my function will generate the default currency tag of Afghani, even
before you assign the AFA tag (unless doing that is a default). Changing the
cell's format to assign the AFA currency tag will not generate a detectable
event, but that won't matter as Afghani is the default. HOWEVER, if you
change the cell's currency tag to $, again no event is generated, so the
written out words will say Afghani even though the currency symbol is $. To
correct the text, you will have to make Excel perform a recalculation of the
worksheet. You can do this simply enough by pressing the F9 key.... BUT you
have to remember to do that. True, then next number you enter will force an
automatic recalculation and the previous text would then be corrected,
however, the last US Dollar number you enter won't read correctly until you
hit F9. I have an idea that may help automate this for you... give me a
little time to see if I can finalize the idea. What I am thinking about will
not change any of the code below, so you can copy/paste it into the Module
you added for my function (replacing everything that is currently in it) and
use it immediately.

Rick

Private sNumberText() As String

'-----------------------------------------
' Modified July 16, 2007
' Modified function name for Excel request
' Original optional argument removed, new
' optional argument for Dollars/AFA added
'-----------------------------------------
Public Function DollarsAFA(NumberIn As Variant) As String
Dim cnt As Long
Dim DecimalPoint As Long
Dim CardinalNumber As Long
Dim CommaAdjuster As Long
Dim TestValue As Long
Dim CurrValue As Currency
Dim CentsString As String
Dim NumberSign As String
Dim WholePart As String
Dim BigWholePart As String
Dim DecimalPart As String
Dim MoneyUnits As String
Dim tmp As String
Dim sStyle As String
Dim bUseAnd As Boolean
Dim bUseCheck As Boolean
Dim bUseDollars As Boolean
' Function made Volatile so it will recalculate
' because formatting is applied after number is entered
Application.Volatile
' Exit function if input is the empty string
If Len(Trim(NumberIn.Value)) = 0 Then Exit Function
'-----------------------------------------
' Added July 16, 2007
' Original optional argument removed, function
' determines Dollars/AFA from NumberFormat
'-----------------------------------------
If InStr(NumberIn.NumberFormat, "$") Then
MoneyUnits = "US Dollars "
Else
MoneyUnits = "Afghani "
End If
'----------------------------------------
' Begin setting conditions for formatting
'----------------------------------------
' Determine whether to apply special formatting.
' If nothing passed, return routine result
' converted only into its numeric equivalents,
' with no additional format text.
'' sStyle = LCase(AND_or_CHECK_or_DOLLAR)
' User passed "AND": "and" will be added
' between hundredths and tens of dollars,
' ie "Three Hundred and Forty Two"
'' bUseAnd = sStyle = "and"
' User passed "DOLLAR": "dollar(s)" and "cents"
' appended to string,
' ie "Three Hundred and Forty Two Dollars"
'' bUseDollars = sStyle = "dollar"
' User passed "CHECK" *or* "DOLLAR"
' If "check", cent amount returned as a fraction /100
' i.e. "Three Hundred Forty Two and 00/100"
' If "dollar" was passed, "dollar(s)" and "cents"
' Appended instead.
'-----------------------------------------
' Modified July 16, 2007
' Old optional arguments for sStyle remove
' and defaulted to bUseCheck
'-----------------------------------------
sStyle = "check"
bUseCheck = (sStyle = "check") Or (sStyle = "dollar")
'----------------------------------------
' Check/create array. If this is the first
' time using this routine, create the text
' strings that will be used.
'----------------------------------------
If Not IsBounded(sNumberText) Then
Call BuildArray(sNumberText)
End If
'----------------------------------------
' Begin validating the number, and breaking
' into constituent parts
'----------------------------------------
' Prepare to check for valid value in
NumberIn = Trim$(NumberIn)
If Not IsNumeric(NumberIn) Then
' Invalid entry - abort
DollarsAFA = "Error - Number improperly formed"
Exit Function
Else
' Decimal check
DecimalPoint = InStr(NumberIn, ".")
If DecimalPoint > 0 Then
' Split the fractional and primary numbers
DecimalPart = Mid$(NumberIn, DecimalPoint + 1)
WholePart = Left$(NumberIn, DecimalPoint - 1)
Else
' Assume the decimal is the last char
DecimalPoint = Len(NumberIn) + 1
WholePart = NumberIn
End If
If InStr(NumberIn, ",,") Or _
InStr(NumberIn, ",.") Or _
InStr(NumberIn, ".,") Or _
InStr(DecimalPart, ",") Then
DollarsAFA = "Error - Improper use of commas"
Exit Function
ElseIf InStr(NumberIn, ",") Then
CommaAdjuster = 0
WholePart = ""
For cnt = DecimalPoint - 1 To 1 Step -1
If Not Mid$(NumberIn, cnt, 1) Like "[,]" Then
WholePart = Mid$(NumberIn, cnt, 1) & WholePart
Else
CommaAdjuster = CommaAdjuster + 1
If (DecimalPoint - cnt - CommaAdjuster) Mod 3 Then
DollarsAFA = "Error - Improper use of commas"
Exit Function
End If
End If
Next
End If
End If
If Left$(WholePart, 1) Like "[+-]" Then
NumberSign = IIf(Left$(WholePart, 1) = "-", "Minus ", "Plus ")
WholePart = Mid$(WholePart, 2)
End If
'----------------------------------------
' Begin code to assure decimal portion of
' check value is not inadvertently rounded
'----------------------------------------
If bUseCheck = True Then
CurrValue = CCur(Val("." & DecimalPart))
DecimalPart = Mid$(Format$(CurrValue, "0.00"), 3, 2)
If CurrValue >= 0.995 Then
If WholePart = String$(Len(WholePart), "9") Then
WholePart = "1" & String$(Len(WholePart), "0")
Else
For cnt = Len(WholePart) To 1 Step -1
If Mid$(WholePart, cnt, 1) = "9" Then
Mid$(WholePart, cnt, 1) = "0"
Else
Mid$(WholePart, cnt, 1) = _
CStr(Val(Mid$(WholePart, cnt, 1)) + 1)
Exit For
End If
Next
End If
End If
End If
'----------------------------------------
' Final prep step - this assures number
' within range of formatting code below
'----------------------------------------
If Len(WholePart) > 9 Then
BigWholePart = Left$(WholePart, Len(WholePart) - 9)
WholePart = Right$(WholePart, 9)
End If
If Len(BigWholePart) > 9 Then
DollarsAFA = "Error - Number too large"
Exit Function
ElseIf Not WholePart Like String$(Len(WholePart), "#") Or _
(Not BigWholePart Like String$(Len(BigWholePart), "#") _
And Len(BigWholePart) > 0) Then
DollarsAFA = "Error - Number improperly formed"
Exit Function
End If
'----------------------------------------
' Begin creating the output string
'----------------------------------------
' Very Large values
TestValue = Val(BigWholePart)
If TestValue > 999999 Then
CardinalNumber = TestValue \ 1000000
tmp = HundredsTensUnits(CardinalNumber) & "Quadrillion "
TestValue = TestValue - (CardinalNumber * 1000000)
End If
If TestValue > 999 Then
CardinalNumber = TestValue \ 1000
tmp = tmp & HundredsTensUnits(CardinalNumber) & "Trillion "
TestValue = TestValue - (CardinalNumber * 1000)
End If
If TestValue > 0 Then
tmp = tmp & HundredsTensUnits(TestValue) & "Billion "
End If
' Lesser values
TestValue = Val(WholePart)
If TestValue = 0 And BigWholePart = "" Then tmp = "Zero "
If TestValue > 999999 Then
CardinalNumber = TestValue \ 1000000
tmp = tmp & HundredsTensUnits(CardinalNumber) & "Million "
TestValue = TestValue - (CardinalNumber * 1000000)
End If
If TestValue > 999 Then
CardinalNumber = TestValue \ 1000
tmp = tmp & HundredsTensUnits(CardinalNumber) & "Thousand "
TestValue = TestValue - (CardinalNumber * 1000)
End If
If TestValue > 0 Then
If Val(WholePart) < 99 And BigWholePart = "" Then bUseAnd = False
tmp = tmp & HundredsTensUnits(TestValue, bUseAnd)
End If
' If in dollar mode, assure the text is the correct plurality
If bUseDollars = True Then
CentsString = HundredsTensUnits(DecimalPart)
If tmp = "One " Then
tmp = tmp & "Dollar"
Else
tmp = tmp & "Dollars"
End If
If Len(CentsString) > 0 Then
tmp = tmp & " and " & CentsString
If CentsString = "One " Then
tmp = tmp & "Cent"
Else
tmp = tmp & "Cents"
End If
End If
ElseIf bUseCheck = True Then
'-----------------------------------------
' Modified July 16, 2007
' New money units text spliced in
'-----------------------------------------
tmp = tmp & MoneyUnits & "and " & Left$(DecimalPart & "00", 2)
tmp = tmp & "/100"
Else
If Len(DecimalPart) > 0 Then
tmp = tmp & "Point"
For cnt = 1 To Len(DecimalPart)
tmp = tmp & " " & sNumberText(Mid$(DecimalPart, cnt, 1))
Next
End If
End If
' Done!
DollarsAFA = NumberSign & tmp
End Function

Private Sub BuildArray(sNumberText() As String)
ReDim sNumberText(0 To 27) As String
sNumberText(0) = "Zero"
sNumberText(1) = "One"
sNumberText(2) = "Two"
sNumberText(3) = "Three"
sNumberText(4) = "Four"
sNumberText(5) = "Five"
sNumberText(6) = "Six"
sNumberText(7) = "Seven"
sNumberText(8) = "Eight"
sNumberText(9) = "Nine"
sNumberText(10) = "Ten"
sNumberText(11) = "Eleven"
sNumberText(12) = "Twelve"
sNumberText(13) = "Thirteen"
sNumberText(14) = "Fourteen"
sNumberText(15) = "Fifteen"
sNumberText(16) = "Sixteen"
sNumberText(17) = "Seventeen"
sNumberText(18) = "Eighteen"
sNumberText(19) = "Nineteen"
sNumberText(20) = "Twenty"
sNumberText(21) = "Thirty"
sNumberText(22) = "Forty"
sNumberText(23) = "Fifty"
sNumberText(24) = "Sixty"
sNumberText(25) = "Seventy"
sNumberText(26) = "Eighty"
sNumberText(27) = "Ninety"
End Sub

Private Function IsBounded(vntArray As Variant) As Boolean
' Note: the application in the IDE will stop
' at this line when first run if the IDE error
' mode is not set to "Break on Unhandled Errors"
' (Tools/Options/General/Error Trapping)
On Error Resume Next
IsBounded = IsNumeric(UBound(vntArray))
End Function

Private Function HundredsTensUnits(ByVal TestValue As Integer, _
Optional bUseAnd As Boolean) As String
Dim CardinalNumber As Integer
If TestValue > 99 Then
CardinalNumber = TestValue \ 100
HundredsTensUnits = sNumberText(CardinalNumber) & " Hundred "
TestValue = TestValue - (CardinalNumber * 100)
End If
If bUseAnd = True Then
HundredsTensUnits = HundredsTensUnits & "and "
End If
If TestValue > 20 Then
CardinalNumber = TestValue \ 10
HundredsTensUnits = HundredsTensUnits & _
sNumberText(CardinalNumber + 18) & " "
TestValue = TestValue - (CardinalNumber * 10)
End If
If TestValue > 0 Then
HundredsTensUnits = HundredsTensUnits & _
sNumberText(TestValue) & " "
End If
End Function

 

[Rick Rothstein \(MVP - VB\)]

I have an idea that may help automate this for you... give me a little

time to see if I can finalize the idea.

Okay, I worked the idea out and I think you will really like it. The first
think to do is add this code to (say, at the end of) the Module you added
for my other code...

Sub ToggleDollarsAFAs()
If InStr(ActiveCell.NumberFormat, "AFA") = 0 Or _
ActiveCell.NumberFormat = "" Then
ActiveCell.NumberFormat = "[$AFA] #,##0.00"
Else
ActiveCell.NumberFormat = "$#,##0.00"
End If
ActiveSheet.Calculate
End Sub

Okay, in Excel (the spreadsheet view, not the VBA editor), right-click on
any Toolbar and select Customize from the popup menu that appears (you will
be leaving this dialog box open until I tell you to close it). Select
"Format" from the Catagories list and then scroll down to "Currency Style"
in the Commands listing on the right. Click on "Currency Style" and drag it
to the main Excel menu bar where you will see a bold vertical line. We are
going to insert the "Currency Style" item into Excel's menu list, so move
the bold vertical bar to wherever you want that item inserted into the menu
at and then let go of the mouse button to place it. Keep in mind, when
placed, it's caption will be two words plus the $ symbol (if you want it),
so it might look best at the end of the list after "Help". Okay, you should
now see just the $ symbol in the menu. Right-click that $ symbol and select
"Assign Macro". On the dialog box that pops up, select ToggleDollarsAFAs
from the list and click OK. Next, right-click the $ symbol again and select
either "Text Only (Always)" or "Image and Text" from the list depending on
if you want to see the $ symbol or not. That is it... hit the Close button
on the Customize dialog box that first appeared and you are done.

Now, select one of your prices on the spreadsheet (this makes it the active
cell so the macro can work). Next, click on the "Currency Style" item you
added to the menu... the currency symbol should change to the opposite of
what it is and the text description for that number should update
automatically. Click the "Currency Style" item again and the currency symbol
will toggle to the other currency format symbol and the text description
will update automatically. Now, for the part I think you will really like.
Because the item is a main menu item, it is reachable directly via the
keyboard with a single keystroke! Select a number cell and hit Alt+C and the
toggling will take place without needing to use the mouse. You no longer
have to individually call up the Format Cell dialog box to change your
currency symbol... just click the menu item or hit Alt+C.

Rick

 

[Guest]

Dear Rick,
I have applied all instructions in my excel sheet and VB editor, the only
problem that I can see is, when I change the currency style to AFA the text
shows US Dollars not Afghani and when I change the currency style with no
format it returns me Afghani which is correct and also when I change the
currency to $ it returns me the correct text (US Dollars). Please try and let
me know. Again thanks for your helps.

Daoud

I have an idea that may help automate this for you... give me a little
time to see if I can finalize the idea.

Okay, I worked the idea out and I think you will really like it. The first
think to do is add this code to (say, at the end of) the Module you added
for my other code...

Sub ToggleDollarsAFAs()
If InStr(ActiveCell.NumberFormat, "AFA") = 0 Or _
ActiveCell.NumberFormat = "" Then
ActiveCell.NumberFormat = "[$AFA] #,##0.00"
Else
ActiveCell.NumberFormat = "$#,##0.00"
End If
ActiveSheet.Calculate
End Sub

Okay, in Excel (the spreadsheet view, not the VBA editor), right-click on
any Toolbar and select Customize from the popup menu that appears (you will
be leaving this dialog box open until I tell you to close it). Select
"Format" from the Catagories list and then scroll down to "Currency Style"
in the Commands listing on the right. Click on "Currency Style" and drag it
to the main Excel menu bar where you will see a bold vertical line. We are
going to insert the "Currency Style" item into Excel's menu list, so move
the bold vertical bar to wherever you want that item inserted into the menu
at and then let go of the mouse button to place it. Keep in mind, when
placed, it's caption will be two words plus the $ symbol (if you want it),
so it might look best at the end of the list after "Help". Okay, you should
now see just the $ symbol in the menu. Right-click that $ symbol and select
"Assign Macro". On the dialog box that pops up, select ToggleDollarsAFAs
from the list and click OK. Next, right-click the $ symbol again and select
either "Text Only (Always)" or "Image and Text" from the list depending on
if you want to see the $ symbol or not. That is it... hit the Close button
on the Customize dialog box that first appeared and you are done.

Now, select one of your prices on the spreadsheet (this makes it the active
cell so the macro can work). Next, click on the "Currency Style" item you
added to the menu... the currency symbol should change to the opposite of
what it is and the text description for that number should update
automatically. Click the "Currency Style" item again and the currency symbol
will toggle to the other currency format symbol and the text description
will update automatically. Now, for the part I think you will really like.
Because the item is a main menu item, it is reachable directly via the
keyboard with a single keystroke! Select a number cell and hit Alt+C and the
toggling will take place without needing to use the mouse. You no longer
have to individually call up the Format Cell dialog box to change your
currency symbol... just click the menu item or hit Alt+C.

Rick

 

[Rick Rothstein \(MVP - VB\)]

I have applied all instructions in my excel sheet and VB editor, the only

problem that I can see is, when I change the currency style to AFA the
text
shows US Dollars not Afghani and when I change the currency style with no
format it returns me Afghani which is correct and also when I change the
currency to $ it returns me the correct text (US Dollars).

Okay, I think I found the problem and I am pretty sure I corrected it. You
will have to forgive me on this, but I never have had to deal with
international (regional) settings issues before, so I misunderstood what was
important in handling them in my previous code. As I said, I think I have
corrected the problem. Please let me know either way.

The solution is to delete ALL of the code in the Module I had you add
earlier and paste the code posted below in it instead. By the way, you can
help make things look "right" immediately if you highlight the column where
your prices are and use Format Cells to give the column an initial currency
format (which I presume would be AFA); then placing a number in the column
will default the number to Afghani; if you need it to be US Dollars, select
the cell and either click the newly added menu item or press Alt+C.

Rick

Private sNumberText() As String

'-----------------------------------------
' Modified July 16, 2007
' Modified function name for Excel request
' Original optional argument removed, new
' optional argument for Dollars/AFA added
'-----------------------------------------
Public Function DollarsAFA(NumberIn As Variant) As String
Dim cnt As Long
Dim DecimalPoint As Long
Dim CardinalNumber As Long
Dim CommaAdjuster As Long
Dim TestValue As Long
Dim CurrValue As Currency
Dim CentsString As String
Dim NumberSign As String
Dim WholePart As String
Dim BigWholePart As String
Dim DecimalPart As String
Dim MoneyUnits As String
Dim tmp As String
Dim sStyle As String
Dim bUseAnd As Boolean
Dim bUseCheck As Boolean
Dim bUseDollars As Boolean
' Function made Volatile so it will recalculate
' because formatting is applied after number is entered
Application.Volatile
' Exit function if input is the empty string
If Len(Trim(NumberIn.Value)) = 0 Then Exit Function
'-----------------------------------------
' Added July 16, 2007
' Original optional argument removed, function
' determines Dollars/AFA from NumberFormat
' Fixed July 17, 2007
' Now looks for exact number format
'-----------------------------------------
If NumberIn.NumberFormat = "$#,##0.00" Then
MoneyUnits = "US Dollars "
ElseIf NumberIn.NumberFormat = "[$AFA] #,##0.00" Then
MoneyUnits = "Afghani "
End If
'----------------------------------------
' Begin setting conditions for formatting
'----------------------------------------
' Determine whether to apply special formatting.
' If nothing passed, return routine result
' converted only into its numeric equivalents,
' with no additional format text.
'' sStyle = LCase(AND_or_CHECK_or_DOLLAR)
' User passed "AND": "and" will be added
' between hundredths and tens of dollars,
' ie "Three Hundred and Forty Two"
'' bUseAnd = sStyle = "and"
' User passed "DOLLAR": "dollar(s)" and "cents"
' appended to string,
' ie "Three Hundred and Forty Two Dollars"
'' bUseDollars = sStyle = "dollar"
' User passed "CHECK" *or* "DOLLAR"
' If "check", cent amount returned as a fraction /100
' i.e. "Three Hundred Forty Two and 00/100"
' If "dollar" was passed, "dollar(s)" and "cents"
' Appended instead.
'-----------------------------------------
' Modified July 16, 2007
' Old optional arguments for sStyle remove
' and defaulted to bUseCheck
'-----------------------------------------
sStyle = "check"
bUseCheck = (sStyle = "check") Or (sStyle = "dollar")
'----------------------------------------
' Check/create array. If this is the first
' time using this routine, create the text
' strings that will be used.
'----------------------------------------
If Not IsBounded(sNumberText) Then
Call BuildArray(sNumberText)
End If
'----------------------------------------
' Begin validating the number, and breaking
' into constituent parts
'----------------------------------------
' Prepare to check for valid value in
NumberIn = Trim$(NumberIn)
If Not IsNumeric(NumberIn) Then
' Invalid entry - abort
DollarsAFA = "Error - Number improperly formed"
Exit Function
Else
' Decimal check
DecimalPoint = InStr(NumberIn, ".")
If DecimalPoint > 0 Then
' Split the fractional and primary numbers
DecimalPart = Mid$(NumberIn, DecimalPoint + 1)
WholePart = Left$(NumberIn, DecimalPoint - 1)
Else
' Assume the decimal is the last char
DecimalPoint = Len(NumberIn) + 1
WholePart = NumberIn
End If
If InStr(NumberIn, ",,") Or _
InStr(NumberIn, ",.") Or _
InStr(NumberIn, ".,") Or _
InStr(DecimalPart, ",") Then
DollarsAFA = "Error - Improper use of commas"
Exit Function
ElseIf InStr(NumberIn, ",") Then
CommaAdjuster = 0
WholePart = ""
For cnt = DecimalPoint - 1 To 1 Step -1
If Not Mid$(NumberIn, cnt, 1) Like "[,]" Then
WholePart = Mid$(NumberIn, cnt, 1) & WholePart
Else
CommaAdjuster = CommaAdjuster + 1
If (DecimalPoint - cnt - CommaAdjuster) Mod 3 Then
DollarsAFA = "Error - Improper use of commas"
Exit Function
End If
End If
Next
End If
End If
If Left$(WholePart, 1) Like "[+-]" Then
NumberSign = IIf(Left$(WholePart, 1) = "-", "Minus ", "Plus ")
WholePart = Mid$(WholePart, 2)
End If
'----------------------------------------
' Begin code to assure decimal portion of
' check value is not inadvertently rounded
'----------------------------------------
If bUseCheck = True Then
CurrValue = CCur(Val("." & DecimalPart))
DecimalPart = Mid$(Format$(CurrValue, "0.00"), 3, 2)
If CurrValue >= 0.995 Then
If WholePart = String$(Len(WholePart), "9") Then
WholePart = "1" & String$(Len(WholePart), "0")
Else
For cnt = Len(WholePart) To 1 Step -1
If Mid$(WholePart, cnt, 1) = "9" Then
Mid$(WholePart, cnt, 1) = "0"
Else
Mid$(WholePart, cnt, 1) = _
CStr(Val(Mid$(WholePart, cnt, 1)) + 1)
Exit For
End If
Next
End If
End If
End If
'----------------------------------------
' Final prep step - this assures number
' within range of formatting code below
'----------------------------------------
If Len(WholePart) > 9 Then
BigWholePart = Left$(WholePart, Len(WholePart) - 9)
WholePart = Right$(WholePart, 9)
End If
If Len(BigWholePart) > 9 Then
DollarsAFA = "Error - Number too large"
Exit Function
ElseIf Not WholePart Like String$(Len(WholePart), "#") Or _
(Not BigWholePart Like String$(Len(BigWholePart), "#") _
And Len(BigWholePart) > 0) Then
DollarsAFA = "Error - Number improperly formed"
Exit Function
End If
'----------------------------------------
' Begin creating the output string
'----------------------------------------
' Very Large values
TestValue = Val(BigWholePart)
If TestValue > 999999 Then
CardinalNumber = TestValue \ 1000000
tmp = HundredsTensUnits(CardinalNumber) & "Quadrillion "
TestValue = TestValue - (CardinalNumber * 1000000)
End If
If TestValue > 999 Then
CardinalNumber = TestValue \ 1000
tmp = tmp & HundredsTensUnits(CardinalNumber) & "Trillion "
TestValue = TestValue - (CardinalNumber * 1000)
End If
If TestValue > 0 Then
tmp = tmp & HundredsTensUnits(TestValue) & "Billion "
End If
' Lesser values
TestValue = Val(WholePart)
If TestValue = 0 And BigWholePart = "" Then tmp = "Zero "
If TestValue > 999999 Then
CardinalNumber = TestValue \ 1000000
tmp = tmp & HundredsTensUnits(CardinalNumber) & "Million "
TestValue = TestValue - (CardinalNumber * 1000000)
End If
If TestValue > 999 Then
CardinalNumber = TestValue \ 1000
tmp = tmp & HundredsTensUnits(CardinalNumber) & "Thousand "
TestValue = TestValue - (CardinalNumber * 1000)
End If
If TestValue > 0 Then
If Val(WholePart) < 99 And BigWholePart = "" Then bUseAnd = False
tmp = tmp & HundredsTensUnits(TestValue, bUseAnd)
End If
' If in dollar mode, assure the text is the correct plurality
If bUseDollars = True Then
CentsString = HundredsTensUnits(DecimalPart)
If tmp = "One " Then
tmp = tmp & "Dollar"
Else
tmp = tmp & "Dollars"
End If
If Len(CentsString) > 0 Then
tmp = tmp & " and " & CentsString
If CentsString = "One " Then
tmp = tmp & "Cent"
Else
tmp = tmp & "Cents"
End If
End If
ElseIf bUseCheck = True Then
'-----------------------------------------
' Modified July 16, 2007
' New money units text spliced in
'-----------------------------------------
tmp = tmp & MoneyUnits & "and " & Left$(DecimalPart & "00", 2)
tmp = tmp & "/100"
Else
If Len(DecimalPart) > 0 Then
tmp = tmp & "Point"
For cnt = 1 To Len(DecimalPart)
tmp = tmp & " " & sNumberText(Mid$(DecimalPart, cnt, 1))
Next
End If
End If
' Done!
DollarsAFA = NumberSign & tmp
End Function

Private Sub BuildArray(sNumberText() As String)
ReDim sNumberText(0 To 27) As String
sNumberText(0) = "Zero"
sNumberText(1) = "One"
sNumberText(2) = "Two"
sNumberText(3) = "Three"
sNumberText(4) = "Four"
sNumberText(5) = "Five"
sNumberText(6) = "Six"
sNumberText(7) = "Seven"
sNumberText(8) = "Eight"
sNumberText(9) = "Nine"
sNumberText(10) = "Ten"
sNumberText(11) = "Eleven"
sNumberText(12) = "Twelve"
sNumberText(13) = "Thirteen"
sNumberText(14) = "Fourteen"
sNumberText(15) = "Fifteen"
sNumberText(16) = "Sixteen"
sNumberText(17) = "Seventeen"
sNumberText(18) = "Eighteen"
sNumberText(19) = "Nineteen"
sNumberText(20) = "Twenty"
sNumberText(21) = "Thirty"
sNumberText(22) = "Forty"
sNumberText(23) = "Fifty"
sNumberText(24) = "Sixty"
sNumberText(25) = "Seventy"
sNumberText(26) = "Eighty"
sNumberText(27) = "Ninety"
End Sub

Private Function IsBounded(vntArray As Variant) As Boolean
' Note: the application in the IDE will stop
' at this line when first run if the IDE error
' mode is not set to "Break on Unhandled Errors"
' (Tools/Options/General/Error Trapping)
On Error Resume Next
IsBounded = IsNumeric(UBound(vntArray))
End Function

Private Function HundredsTensUnits(ByVal TestValue As Integer, _
Optional bUseAnd As Boolean) As String
Dim CardinalNumber As Integer
If TestValue > 99 Then
CardinalNumber = TestValue \ 100
HundredsTensUnits = sNumberText(CardinalNumber) & " Hundred "
TestValue = TestValue - (CardinalNumber * 100)
End If
If bUseAnd = True Then
HundredsTensUnits = HundredsTensUnits & "and "
End If
If TestValue > 20 Then
CardinalNumber = TestValue \ 10
HundredsTensUnits = HundredsTensUnits & _
sNumberText(CardinalNumber + 18) & " "
TestValue = TestValue - (CardinalNumber * 10)
End If
If TestValue > 0 Then
HundredsTensUnits = HundredsTensUnits & _
sNumberText(TestValue) & " "
End If
End Function

'----------------------------------------
' Fixed July 17, 2007
' Recast the entire subroutine to correct improper functioning
'----------------------------------------
Sub ToggleDollarsAFAs()
If ActiveCell.NumberFormat = "[$AFA] #,##0.00" Then
ActiveCell.NumberFormat = "$#,##0.00"
ElseIf ActiveCell.NumberFormat = "$#,##0.00" Then
ActiveCell.NumberFormat = "[$AFA] #,##0.00"
Else
ActiveCell.NumberFormat = "[$AFA] #,##0.00"
End If
ActiveSheet.Calculate
End Sub

 

[Guest]

Thanks Rick, now it works perfect. I appreciate it.
Daoud Fakhry

I have applied all instructions in my excel sheet and VB editor, the only
problem that I can see is, when I change the currency style to AFA the
text
shows US Dollars not Afghani and when I change the currency style with no
format it returns me Afghani which is correct and also when I change the
currency to $ it returns me the correct text (US Dollars).

Okay, I think I found the problem and I am pretty sure I corrected it. You
will have to forgive me on this, but I never have had to deal with
international (regional) settings issues before, so I misunderstood what was
important in handling them in my previous code. As I said, I think I have
corrected the problem. Please let me know either way.

The solution is to delete ALL of the code in the Module I had you add
earlier and paste the code posted below in it instead. By the way, you can
help make things look "right" immediately if you highlight the column where
your prices are and use Format Cells to give the column an initial currency
format (which I presume would be AFA); then placing a number in the column
will default the number to Afghani; if you need it to be US Dollars, select
the cell and either click the newly added menu item or press Alt+C.

Rick

Private sNumberText() As String

'-----------------------------------------
' Modified July 16, 2007
' Modified function name for Excel request
' Original optional argument removed, new
' optional argument for Dollars/AFA added
'-----------------------------------------
Public Function DollarsAFA(NumberIn As Variant) As String
Dim cnt As Long
Dim DecimalPoint As Long
Dim CardinalNumber As Long
Dim CommaAdjuster As Long
Dim TestValue As Long
Dim CurrValue As Currency
Dim CentsString As String
Dim NumberSign As String
Dim WholePart As String
Dim BigWholePart As String
Dim DecimalPart As String
Dim MoneyUnits As String
Dim tmp As String
Dim sStyle As String
Dim bUseAnd As Boolean
Dim bUseCheck As Boolean
Dim bUseDollars As Boolean
' Function made Volatile so it will recalculate
' because formatting is applied after number is entered
Application.Volatile
' Exit function if input is the empty string
If Len(Trim(NumberIn.Value)) = 0 Then Exit Function
'-----------------------------------------
' Added July 16, 2007
' Original optional argument removed, function
' determines Dollars/AFA from NumberFormat
' Fixed July 17, 2007
' Now looks for exact number format
'-----------------------------------------
If NumberIn.NumberFormat = "$#,##0.00" Then
MoneyUnits = "US Dollars "
ElseIf NumberIn.NumberFormat = "[$AFA] #,##0.00" Then
MoneyUnits = "Afghani "
End If
'----------------------------------------
' Begin setting conditions for formatting
'----------------------------------------
' Determine whether to apply special formatting.
' If nothing passed, return routine result
' converted only into its numeric equivalents,
' with no additional format text.
'' sStyle = LCase(AND_or_CHECK_or_DOLLAR)
' User passed "AND": "and" will be added
' between hundredths and tens of dollars,
' ie "Three Hundred and Forty Two"
'' bUseAnd = sStyle = "and"
' User passed "DOLLAR": "dollar(s)" and "cents"
' appended to string,
' ie "Three Hundred and Forty Two Dollars"
'' bUseDollars = sStyle = "dollar"
' User passed "CHECK" *or* "DOLLAR"
' If "check", cent amount returned as a fraction /100
' i.e. "Three Hundred Forty Two and 00/100"
' If "dollar" was passed, "dollar(s)" and "cents"
' Appended instead.
'-----------------------------------------
' Modified July 16, 2007
' Old optional arguments for sStyle remove
' and defaulted to bUseCheck
'-----------------------------------------
sStyle = "check"
bUseCheck = (sStyle = "check") Or (sStyle = "dollar")
'----------------------------------------
' Check/create array. If this is the first
' time using this routine, create the text
' strings that will be used.
'----------------------------------------
If Not IsBounded(sNumberText) Then
Call BuildArray(sNumberText)
End If
'----------------------------------------
' Begin validating the number, and breaking
' into constituent parts
'----------------------------------------
' Prepare to check for valid value in
NumberIn = Trim$(NumberIn)
If Not IsNumeric(NumberIn) Then
' Invalid entry - abort
DollarsAFA = "Error - Number improperly formed"
Exit Function
Else
' Decimal check
DecimalPoint = InStr(NumberIn, ".")
If DecimalPoint > 0 Then
' Split the fractional and primary numbers
DecimalPart = Mid$(NumberIn, DecimalPoint + 1)
WholePart = Left$(NumberIn, DecimalPoint - 1)
Else
' Assume the decimal is the last char
DecimalPoint = Len(NumberIn) + 1
WholePart = NumberIn
End If
If InStr(NumberIn, ",,") Or _
InStr(NumberIn, ",.") Or _
InStr(NumberIn, ".,") Or _
InStr(DecimalPart, ",") Then
DollarsAFA = "Error - Improper use of commas"
Exit Function
ElseIf InStr(NumberIn, ",") Then
CommaAdjuster = 0
WholePart = ""
For cnt = DecimalPoint - 1 To 1 Step -1
If Not Mid$(NumberIn, cnt, 1) Like "[,]" Then
WholePart = Mid$(NumberIn, cnt, 1) & WholePart
Else
CommaAdjuster = CommaAdjuster + 1
If (DecimalPoint - cnt - CommaAdjuster) Mod 3 Then
DollarsAFA = "Error - Improper use of commas"
Exit Function
End If
End If
Next
End If
End If
If Left$(WholePart, 1) Like "[+-]" Then
NumberSign = IIf(Left$(WholePart, 1) = "-", "Minus ", "Plus ")
WholePart = Mid$(WholePart, 2)
End If
'----------------------------------------
' Begin code to assure decimal portion of
' check value is not inadvertently rounded
'----------------------------------------
If bUseCheck = True Then
CurrValue = CCur(Val("." & DecimalPart))
DecimalPart = Mid$(Format$(CurrValue, "0.00"), 3, 2)
If CurrValue >= 0.995 Then
If WholePart = String$(Len(WholePart), "9") Then
WholePart = "1" & String$(Len(WholePart), "0")
Else
For cnt = Len(WholePart) To 1 Step -1
If Mid$(WholePart, cnt, 1) = "9" Then
Mid$(WholePart, cnt, 1) = "0"
Else
Mid$(WholePart, cnt, 1) = _
CStr(Val(Mid$(WholePart, cnt, 1)) + 1)
Exit For
End If
Next
End If
End If
End If
'----------------------------------------
' Final prep step - this assures number
' within range of formatting code below
'----------------------------------------
If Len(WholePart) > 9 Then
BigWholePart = Left$(WholePart, Len(WholePart) - 9)
WholePart = Right$(WholePart, 9)
End If
If Len(BigWholePart) > 9 Then
DollarsAFA = "Error - Number too large"
Exit Function
ElseIf Not WholePart Like String$(Len(WholePart), "#") Or _
(Not BigWholePart Like String$(Len(BigWholePart), "#") _
And Len(BigWholePart) > 0) Then
DollarsAFA = "Error - Number improperly formed"
Exit Function
End If
'----------------------------------------
' Begin creating the output string
'----------------------------------------
' Very Large values
TestValue = Val(BigWholePart)
If TestValue > 999999 Then
CardinalNumber = TestValue \ 1000000
tmp = HundredsTensUnits(CardinalNumber) & "Quadrillion "
TestValue = TestValue - (CardinalNumber * 1000000)
End If
If TestValue > 999 Then
CardinalNumber = TestValue \ 1000
tmp = tmp & HundredsTensUnits(CardinalNumber) & "Trillion "
TestValue = TestValue - (CardinalNumber * 1000)
End If
If TestValue > 0 Then
tmp = tmp & HundredsTensUnits(TestValue) & "Billion "
End If
' Lesser values
TestValue = Val(WholePart)
If TestValue = 0 And BigWholePart = "" Then tmp = "Zero "
If TestValue > 999999 Then
CardinalNumber = TestValue \ 1000000
tmp = tmp & HundredsTensUnits(CardinalNumber) & "Million "
TestValue = TestValue - (CardinalNumber * 1000000)
End If
If TestValue > 999 Then
CardinalNumber = TestValue \ 1000
tmp = tmp & HundredsTensUnits(CardinalNumber) & "Thousand "
TestValue = TestValue - (CardinalNumber * 1000)
End If
If TestValue > 0 Then
If Val(WholePart) < 99 And BigWholePart = "" Then bUseAnd = False
tmp = tmp & HundredsTensUnits(TestValue, bUseAnd)
End If
' If in dollar mode, assure the text is the correct plurality
If bUseDollars = True Then
CentsString = HundredsTensUnits(DecimalPart)
If tmp = "One " Then
tmp = tmp & "Dollar"
Else
tmp = tmp & "Dollars"
End If
If Len(CentsString) > 0 Then
tmp = tmp & " and " & CentsString
If CentsString = "One " Then
tmp = tmp & "Cent"
Else
tmp = tmp & "Cents"
End If
End If
ElseIf bUseCheck = True Then
'-----------------------------------------
' Modified July 16, 2007
' New money units text spliced in
'-----------------------------------------
tmp = tmp & MoneyUnits & "and " & Left$(DecimalPart & "00", 2)
tmp = tmp & "/100"
Else
If Len(DecimalPart) > 0 Then
tmp = tmp & "Point"
For cnt = 1 To Len(DecimalPart)
tmp = tmp & " " & sNumberText(Mid$(DecimalPart, cnt, 1))
Next
End If
End If
' Done!
DollarsAFA = NumberSign & tmp
End Function

Private Sub BuildArray(sNumberText() As String)
ReDim sNumberText(0 To 27) As String
sNumberText(0) = "Zero"
sNumberText(1) = "One"
sNumberText(2) = "Two"
sNumberText(3) = "Three"
sNumberText(4) = "Four"
sNumberText(5) = "Five"
sNumberText(6) = "Six"
sNumberText(7) = "Seven"
sNumberText(8) = "Eight"
sNumberText(9) = "Nine"
sNumberText(10) = "Ten"
sNumberText(11) = "Eleven"
sNumberText(12) = "Twelve"
sNumberText(13) = "Thirteen"
sNumberText(14) = "Fourteen"
sNumberText(15) = "Fifteen"
sNumberText(16) = "Sixteen"
sNumberText(17) = "Seventeen"
sNumberText(18) = "Eighteen"
sNumberText(19) = "Nineteen"
sNumberText(20) = "Twenty"
sNumberText(21) = "Thirty"
sNumberText(22) = "Forty"
sNumberText(23) = "Fifty"
sNumberText(24) = "Sixty"
sNumberText(25) = "Seventy"
sNumberText(26) = "Eighty"
sNumberText(27) = "Ninety"
End Sub

Private Function IsBounded(vntArray As Variant) As Boolean
' Note: the application in the IDE will stop
' at this line when first run if the IDE error
' mode is not set to "Break on Unhandled Errors"
' (Tools/Options/General/Error Trapping)
On Error Resume Next
IsBounded = IsNumeric(UBound(vntArray))
End Function

 

[Rick Rothstein \(MVP - VB\)]

Thanks Rick, now it works perfect. I appreciate it.

Great! I knew we would get it... eventually.<g>

How is the added menu item (and keyboard shortcut) working out for you?
Easier than what you were doing in the past I hope.

Rick

 

[Guest]

Yeah, it is very easy now for me and I am sure I can use it for my other
sheets as well. I have posted another question which is (Recognizing specific
date with Formula) today. Please review and I am sure you can help me.

 

[Guest]

Dear Rick,
I have got another problem, which is coming out from ToggleDollarsAFA macro.
I have used your functions in an excel sheet as a draft and now when I tried
to anothr workbook it give me error and ask that the *.xle file is not found.
I have deleted the macro from that file also, but the problem didn't solved.
How can I delete a macro so I delete it for ever in excel. I know this macro
is some where but I can't find it.

Thanks,

 

[Rick Rothstein \(MVP - VB\)]

You are going to have to provide some more information. I tried looking up
the .xle extension and did not find a reference to it for Excel. Also, the
ToggleDollarsAFA macro is quite simple and bland, so I have trouble
imagining it affecting file operations of any kind (all the macro does is
toggle the number format of the active cell, nothing more). When you
installed the macro to this other workbook, exactly how did you do that
(explain the steps you did)? The more detail you can give me about the steps
you took, the better able I (or anyone else here) can figure out what might
have happened. What about the sNumberText code... did you put that in this
other workbook too?

Rick

 

[Guest]

I think what I did is that I had multiple workbooks was open in the same time
while I have pasted the function. for sure I put the sNumberText code as well
in the other workbook.

Thanks,

 

[Guest]

Dear Rick,
I have a small problem using this function. I have created a new workbook
called spellnumber.xls and applied your function. What happens now, when I am
trying this function I should have that the spellnumber.xls in my document
folder with the code you have sent. I have deleted the module from
spellnumber and also the workbook it self but still when I using Alt+c for
toggling USD/AFA it gives me error - the macro
'spellnumber.xls!ToggleDollarsAFAs' connot be found. Even I have deleted the
macro from spellnumber.xls but I can't use this function properly.

Thanks,

I have applied all instructions in my excel sheet and VB editor, the only
problem that I can see is, when I change the currency style to AFA the
text
shows US Dollars not Afghani and when I change the currency style with no
format it returns me Afghani which is correct and also when I change the
currency to $ it returns me the correct text (US Dollars).

Okay, I think I found the problem and I am pretty sure I corrected it. You
will have to forgive me on this, but I never have had to deal with
international (regional) settings issues before, so I misunderstood what was
important in handling them in my previous code. As I said, I think I have
corrected the problem. Please let me know either way.

The solution is to delete ALL of the code in the Module I had you add
earlier and paste the code posted below in it instead. By the way, you can
help make things look "right" immediately if you highlight the column where
your prices are and use Format Cells to give the column an initial currency
format (which I presume would be AFA); then placing a number in the column
will default the number to Afghani; if you need it to be US Dollars, select
the cell and either click the newly added menu item or press Alt+C.

Rick

Private sNumberText() As String

'-----------------------------------------
' Modified July 16, 2007
' Modified function name for Excel request
' Original optional argument removed, new
' optional argument for Dollars/AFA added
'-----------------------------------------
Public Function DollarsAFA(NumberIn As Variant) As String
Dim cnt As Long
Dim DecimalPoint As Long
Dim CardinalNumber As Long
Dim CommaAdjuster As Long
Dim TestValue As Long
Dim CurrValue As Currency
Dim CentsString As String
Dim NumberSign As String
Dim WholePart As String
Dim BigWholePart As String
Dim DecimalPart As String
Dim MoneyUnits As String
Dim tmp As String
Dim sStyle As String
Dim bUseAnd As Boolean
Dim bUseCheck As Boolean
Dim bUseDollars As Boolean
' Function made Volatile so it will recalculate
' because formatting is applied after number is entered
Application.Volatile
' Exit function if input is the empty string
If Len(Trim(NumberIn.Value)) = 0 Then Exit Function
'-----------------------------------------
' Added July 16, 2007
' Original optional argument removed, function
' determines Dollars/AFA from NumberFormat
' Fixed July 17, 2007
' Now looks for exact number format
'-----------------------------------------
If NumberIn.NumberFormat = "$#,##0.00" Then
MoneyUnits = "US Dollars "
ElseIf NumberIn.NumberFormat = "[$AFA] #,##0.00" Then
MoneyUnits = "Afghani "
End If
'----------------------------------------
' Begin setting conditions for formatting
'----------------------------------------
' Determine whether to apply special formatting.
' If nothing passed, return routine result
' converted only into its numeric equivalents,
' with no additional format text.
'' sStyle = LCase(AND_or_CHECK_or_DOLLAR)
' User passed "AND": "and" will be added
' between hundredths and tens of dollars,
' ie "Three Hundred and Forty Two"
'' bUseAnd = sStyle = "and"
' User passed "DOLLAR": "dollar(s)" and "cents"
' appended to string,
' ie "Three Hundred and Forty Two Dollars"
'' bUseDollars = sStyle = "dollar"
' User passed "CHECK" *or* "DOLLAR"
' If "check", cent amount returned as a fraction /100
' i.e. "Three Hundred Forty Two and 00/100"
' If "dollar" was passed, "dollar(s)" and "cents"
' Appended instead.
'-----------------------------------------
' Modified July 16, 2007
' Old optional arguments for sStyle remove
' and defaulted to bUseCheck
'-----------------------------------------
sStyle = "check"
bUseCheck = (sStyle = "check") Or (sStyle = "dollar")
'----------------------------------------
' Check/create array. If this is the first
' time using this routine, create the text
' strings that will be used.
'----------------------------------------
If Not IsBounded(sNumberText) Then
Call BuildArray(sNumberText)
End If
'----------------------------------------
' Begin validating the number, and breaking
' into constituent parts
'----------------------------------------
' Prepare to check for valid value in
NumberIn = Trim$(NumberIn)
If Not IsNumeric(NumberIn) Then
' Invalid entry - abort
DollarsAFA = "Error - Number improperly formed"
Exit Function
Else
' Decimal check
DecimalPoint = InStr(NumberIn, ".")
If DecimalPoint > 0 Then
' Split the fractional and primary numbers
DecimalPart = Mid$(NumberIn, DecimalPoint + 1)
WholePart = Left$(NumberIn, DecimalPoint - 1)
Else
' Assume the decimal is the last char
DecimalPoint = Len(NumberIn) + 1
WholePart = NumberIn
End If
If InStr(NumberIn, ",,") Or _
InStr(NumberIn, ",.") Or _
InStr(NumberIn, ".,") Or _
InStr(DecimalPart, ",") Then
DollarsAFA = "Error - Improper use of commas"
Exit Function
ElseIf InStr(NumberIn, ",") Then
CommaAdjuster = 0
WholePart = ""
For cnt = DecimalPoint - 1 To 1 Step -1
If Not Mid$(NumberIn, cnt, 1) Like "[,]" Then
WholePart = Mid$(NumberIn, cnt, 1) & WholePart
Else
CommaAdjuster = CommaAdjuster + 1
If (DecimalPoint - cnt - CommaAdjuster) Mod 3 Then
DollarsAFA = "Error - Improper use of commas"
Exit Function
End If
End If
Next
End If
End If
If Left$(WholePart, 1) Like "[+-]" Then
NumberSign = IIf(Left$(WholePart, 1) = "-", "Minus ", "Plus ")
WholePart = Mid$(WholePart, 2)
End If
'----------------------------------------
' Begin code to assure decimal portion of
' check value is not inadvertently rounded
'----------------------------------------
If bUseCheck = True Then
CurrValue = CCur(Val("." & DecimalPart))
DecimalPart = Mid$(Format$(CurrValue, "0.00"), 3, 2)
If CurrValue >= 0.995 Then
If WholePart = String$(Len(WholePart), "9") Then
WholePart = "1" & String$(Len(WholePart), "0")
Else
For cnt = Len(WholePart) To 1 Step -1
If Mid$(WholePart, cnt, 1) = "9" Then
Mid$(WholePart, cnt, 1) = "0"
Else
Mid$(WholePart, cnt, 1) = _
CStr(Val(Mid$(WholePart, cnt, 1)) + 1)
Exit For
End If
Next
End If
End If
End If
'----------------------------------------
' Final prep step - this assures number
' within range of formatting code below
'----------------------------------------
If Len(WholePart) > 9 Then
BigWholePart = Left$(WholePart, Len(WholePart) - 9)
WholePart = Right$(WholePart, 9)
End If
If Len(BigWholePart) > 9 Then
DollarsAFA = "Error - Number too large"
Exit Function
ElseIf Not WholePart Like String$(Len(WholePart), "#") Or _
(Not BigWholePart Like String$(Len(BigWholePart), "#") _
And Len(BigWholePart) > 0) Then
DollarsAFA = "Error - Number improperly formed"
Exit Function
End If
'----------------------------------------
' Begin creating the output string
'----------------------------------------
' Very Large values
TestValue = Val(BigWholePart)
If TestValue > 999999 Then
CardinalNumber = TestValue \ 1000000
tmp = HundredsTensUnits(CardinalNumber) & "Quadrillion "
TestValue = TestValue - (CardinalNumber * 1000000)
End If
If TestValue > 999 Then
CardinalNumber = TestValue \ 1000
tmp = tmp & HundredsTensUnits(CardinalNumber) & "Trillion "
TestValue = TestValue - (CardinalNumber * 1000)
End If
If TestValue > 0 Then
tmp = tmp & HundredsTensUnits(TestValue) & "Billion "
End If
' Lesser values
TestValue = Val(WholePart)
If TestValue = 0 And BigWholePart = "" Then tmp = "Zero "
If TestValue > 999999 Then
CardinalNumber = TestValue \ 1000000
tmp = tmp & HundredsTensUnits(CardinalNumber) & "Million "
TestValue = TestValue - (CardinalNumber * 1000000)
End If
If TestValue > 999 Then
CardinalNumber = TestValue \ 1000
tmp = tmp & HundredsTensUnits(CardinalNumber) & "Thousand "
TestValue = TestValue - (CardinalNumber * 1000)
End If
If TestValue > 0 Then
If Val(WholePart) < 99 And BigWholePart = "" Then bUseAnd = False
tmp = tmp & HundredsTensUnits(TestValue, bUseAnd)
End If
' If in dollar mode, assure the text is the correct plurality
If bUseDollars = True Then
CentsString = HundredsTensUnits(DecimalPart)
If tmp = "One " Then
tmp = tmp & "Dollar"
Else
tmp = tmp & "Dollars"
End If
If Len(CentsString) > 0 Then
tmp = tmp & " and " & CentsString
If CentsString = "One " Then
tmp = tmp & "Cent"
Else
tmp = tmp & "Cents"
End If
End If
ElseIf bUseCheck = True Then
'-----------------------------------------
' Modified July 16, 2007
' New money units text spliced in
'-----------------------------------------
tmp = tmp & MoneyUnits & "and " & Left$(DecimalPart & "00", 2)
tmp = tmp & "/100"
Else
If Len(DecimalPart) > 0 Then
tmp = tmp & "Point"
For cnt = 1 To Len(DecimalPart)
tmp = tmp & " " & sNumberText(Mid$(DecimalPart, cnt, 1))
Next
End If
End If
' Done!
DollarsAFA = NumberSign & tmp
End Function

Private Sub BuildArray(sNumberText() As String)
ReDim sNumberText(0 To 27) As String
sNumberText(0) = "Zero"
sNumberText(1) = "One"
sNumberText(2) = "Two"
sNumberText(3) = "Three"
sNumberText(4) = "Four"
sNumberText(5) = "Five"
sNumberText(6) = "Six"
sNumberText(7) = "Seven"
sNumberText(8) = "Eight"
sNumberText(9) = "Nine"
sNumberText(10) = "Ten"
sNumberText(11) = "Eleven"
sNumberText(12) = "Twelve"
sNumberText(13) = "Thirteen"
sNumberText(14) = "Fourteen"
sNumberText(15) = "Fifteen"
sNumberText(16) = "Sixteen"
sNumberText(17) = "Seventeen"
sNumberText(18) = "Eighteen"
sNumberText(19) = "Nineteen"
sNumberText(20) = "Twenty"
sNumberText(21) = "Thirty"
sNumberText(22) = "Forty"
sNumberText(23) = "Fifty"
sNumberText(24) = "Sixty"
sNumberText(25) = "Seventy"
sNumberText(26) = "Eighty"
sNumberText(27) = "Ninety"
End Sub

Private Function IsBounded(vntArray As Variant) As Boolean
' Note: the application in the IDE will stop
' at this line when first run if the IDE error
' mode is not set to "Break on Unhandled Errors"
' (Tools/Options/General/Error Trapping)
On Error Resume Next
IsBounded = IsNumeric(UBound(vntArray))
End Function