![]() |
Spellnumber - USD/AFa
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/comm...xp=&sloc=en-us Is there any one who can help me, thanks. Daoud Fakhry |
Spellnumber - USD/AFa
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 "Daoud Fakhry" wrote: 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/comm...xp=&sloc=en-us Is there any one who can help me, thanks. Daoud Fakhry |
Spellnumber - USD/AFa
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 "Michael M" wrote: 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 "Daoud Fakhry" wrote: 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/comm...xp=&sloc=en-us Is there any one who can help me, thanks. Daoud Fakhry |
Spellnumber - USD/AFa
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 "Daoud Fakhry" wrote in message ... 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 "Michael M" wrote: 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 "Daoud Fakhry" wrote: 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/comm...xp=&sloc=en-us Is there any one who can help me, thanks. Daoud Fakhry |
Spellnumber - USD/AFa
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, "Bernie Deitrick" wrote: 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 "Daoud Fakhry" wrote in message ... 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 "Michael M" wrote: 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 "Daoud Fakhry" wrote: 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/comm...xp=&sloc=en-us Is there any one who can help me, thanks. Daoud Fakhry |
Spellnumber - USD/AFa
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 "Daoud Fakhry" wrote in message ... 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, "Bernie Deitrick" wrote: 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 "Daoud Fakhry" wrote in message ... 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 "Michael M" wrote: 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 "Daoud Fakhry" wrote: 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/comm...xp=&sloc=en-us Is there any one who can help me, thanks. Daoud Fakhry |
Spellnumber - USD/AFa
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)" wrote: 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 "Daoud Fakhry" wrote in message ... 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, "Bernie Deitrick" wrote: 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 "Daoud Fakhry" wrote in message ... 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 "Michael M" wrote: 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 "Daoud Fakhry" wrote: 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/comm...xp=&sloc=en-us Is there any one who can help me, thanks. Daoud Fakhry |
Spellnumber - USD/AFa
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 |
Spellnumber - USD/AFa
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 "Rick Rothstein (MVP - VB)" wrote: 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" |
Spellnumber - USD/AFa
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 |
Spellnumber - USD/AFa
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 |
Spellnumber - USD/AFa
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 "Rick Rothstein (MVP - VB)" wrote: 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 |
Spellnumber - USD/AFa
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 |
Spellnumber - USD/AFa
Thanks Rick, now it works perfect. I appreciate it.
Daoud Fakhry "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 |
Spellnumber - USD/AFa
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 |
Spellnumber - USD/AFa
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. "Rick Rothstein (MVP - VB)" wrote: 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 |
Spellnumber - USD/AFa
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)" wrote: 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 |
Spellnumber - USD/AFa
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 "Daoud Fakhry" wrote in message ... 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)" wrote: 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 |
Spellnumber - USD/AFa
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, "Rick Rothstein (MVP - VB)" wrote: 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 "Daoud Fakhry" wrote in message ... 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)" wrote: 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 |
Spellnumber - USD/AFa
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 |
Spellnumber - USD/AFa
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 |
Spellnumber - USD/AFa
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" |
Spellnumber - USD/AFa
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" |
Spellnumber - USD/AFa
i want use this spell number function but as im in indian i need indian
currency for example 7812= seven thousand eight hundred twelve rupees please help me "Daoud Fakhry" wrote: 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/comm...xp=&sloc=en-us Is there any one who can help me, thanks. Daoud Fakhry |
Spellnumber - USD/AFa
I can probably modify mine to work for you. Here in the US we have dollars
and cents... you said rupees, which I presume corresponds to dollars... do you have a sub-division of rupees that would correspond to cents? Rick "nandini" wrote in message ... i want use this spell number function but as im in indian i need indian currency for example 7812= seven thousand eight hundred twelve rupees please help me "Daoud Fakhry" wrote: 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/comm...xp=&sloc=en-us Is there any one who can help me, thanks. Daoud Fakhry |
Spellnumber - USD/AFa
Try this one from the programming group:
http://preview.tinyurl.com/2az4hr (or http://groups.google.co.uk/group/mic...cc1286d078593c) -- David Biddulph "nandini" wrote in message ... i want use this spell number function but as im in indian i need indian currency for example 7812= seven thousand eight hundred twelve rupees please help me "Daoud Fakhry" wrote: 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/comm...xp=&sloc=en-us Is there any one who can help me, thanks. Daoud Fakhry |
Spellnumber - USD/AFa
Laurent Longre has an add-in with multi-lingual options..........13 to be exact.
http://longre.free.fr/english/index.html Gord Dibben MS Excel MVP On Fri, 7 Sep 2007 05:40:03 -0700, nandini wrote: i want use this spell number function but as im in indian i need indian currency for example 7812= seven thousand eight hundred twelve rupees please help me "Daoud Fakhry" wrote: 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/comm...xp=&sloc=en-us Is there any one who can help me, thanks. Daoud Fakhry |
All times are GMT +1. The time now is 06:56 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com