I'm not following what you have done here. What do you mean by you "applied
your function" and by "I have deleted the module"... the function requires
the module in order to work. Also, Alt+C won't work for toggling USD/AFA
unless you install the menu item in the way I described in my original
posting. If neither of these statements help you out, you will need to
provide more information about what you are doing (or have done).

Rick


"Daoud Fakhry" wrote in message
...
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,
"Rick Rothstein (MVP - VB)" wrote:

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

Thanks rick,
I understand what I did wrong. While I was applying the function in the
other workbooks I should have assign the ToggleDollarsAFA in currency style
menu, which I forgot to do it.

I assigned ToggleDollarsAFA to currency and it works perfect, thanks again
for your hard work and efforts on this issue. I really appreciated it.

Regards, Daoud Fakhry

"Rick Rothstein (MVP - VB)" wrote:

I'm not following what you have done here. What do you mean by you "applied
your function" and by "I have deleted the module"... the function requires
the module in order to work. Also, Alt+C won't work for toggling USD/AFA
unless you install the menu item in the way I described in my original
posting. If neither of these statements help you out, you will need to
provide more information about what you are doing (or have done).

Rick


"Daoud Fakhry" wrote in message
...
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,
"Rick Rothstein (MVP - VB)" wrote:

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"

You are quite welcome... I am glad you have resolved the problem and it is
working for you now.

Rick


"Daoud Fakhry" wrote in message
...
Thanks rick,
I understand what I did wrong. While I was applying the function in the
other workbooks I should have assign the ToggleDollarsAFA in currency
style
menu, which I forgot to do it.

I assigned ToggleDollarsAFA to currency and it works perfect, thanks again
for your hard work and efforts on this issue. I really appreciated it.

Regards, Daoud Fakhry

"Rick Rothstein (MVP - VB)" wrote:

I'm not following what you have done here. What do you mean by you
"applied
your function" and by "I have deleted the module"... the function
requires
the module in order to work. Also, Alt+C won't work for toggling USD/AFA
unless you install the menu item in the way I described in my original
posting. If neither of these statements help you out, you will need to
provide more information about what you are doing (or have done).

Rick


"Daoud Fakhry" wrote in message
...
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,
"Rick Rothstein (MVP - VB)" wrote:

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"