PDA

View Full Version : Modification of user defined funtion



khokababu
2012-04-01, 07:17 PM
Dear The VBA coding given below change numeric value to word. But if the numeric value is
1. "24674", it changes into "Twenty Four thousand Six hundred Seventy Four",
2. "324674", the function changes it in "Three hundred twenty four thousand six hundred seventy four"
3. "2324674" into "Two million Three hundred Twenty Four thousand Six hundred Seventy Four"
4. "52324674" into "Fifty Two million Three hundred Twenty Four thousand Six hundred Seventy Four".
5. 752324674 into "Seven hundred Fifty Two million Three hundred Twenty Four thousand Six hundred Seventy Four"
According to the Indian uses the first one is used but in place of second one we use " Three lakh Twenty Four thousand Six hundred Seventy Four". In Place of Third one we use "Twenty Three lakh Twenty Four thousand Six hundred Seventy Four" and in place of fourth one we use "Five crore Twenty Three lakh Twenty Four thousand Six hundred Seventy Four" and in place of fifth one we use "Seventy Five crore Twenty Three lakh Twenty Four thousand Six hundred Seventy Four". Kindly change the code accordingly.

Function words(fig, Optional point = "Point") As String
Dim digit(14) As Integer
alpha = Array("", "One", "Two", "Three", "Four", "Five", "Six", "Seven", "Eight", "Nine", "Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", "Sixteen", "Seventeen", "Eighteen", "Nineteen", "Twenty", "Thirty", "Forty", "Fifty", "Sixty", "Seventy", "Eighty", "Ninety")
figi = Trim(StrReverse(Str(Int(Abs(fig)))))
For i = 1 To Len(figi)
digit(i) = Mid(figi, i, 1)
Next
For i = 2 To Len(figi) Step 3
If digit(i) = 1 Then
digit(i) = digit(i - 1) + 10: digit(i - 1) = 0
Else: If digit(i) > 1 Then digit(i) = digit(i) + 18
End If
Next
For i = 1 To Len(figi)
If (i Mod 3) = 0 And digit(i) > 0 Then words = "hundred " & words
If (i Mod 3) = 1 And digit(i) + digit(i + 1) + digit(i + 2) > 0 Then _
words = Choose(i / 3, "thousand ", "million ", "billion ") & words
words = Trim(alpha(digit(i)) & " " & words)
Next
If fig <> Int(fig) Then
figc = StrReverse(figi)
If figc = 0 Then figc = ""
figd = Trim(WorksheetFunction.Substitute(Str(Abs(fig)), figc & ".", ""))
words = Trim(words & " " & point)
For i = 1 To Len(figd)
If Val(Mid(figd, i, 1)) > 0 Then
words = words & " " & alpha(Mid(figd, i, 1))
Else: words = words & " Zero"
End If
Next
End If
If fig < 0 Then words = "Negative " & words
End Function

The more unites (In India) are
1 Unit
10 Ten
100 1 hundred
1,000 1 thousand
10,000 10 thousand
1,00,000 1 lakh
10,00,000 10 lakh
1,00,00,000 1 crore
10,00,00,000 10 crore
1,00,00,00,000 1 arab
10,00,00,00,000 10 arab
1,00,00,00,00,000 1 kharab
10,00,00,00,00,000 10 kharab
1,00.00.00.00.00.000 1 neel
10,00,00,00,00,00,000 10 neel
1,00,00,00,00,00,00,000 1 padm
10,00,00,00,00,00,00,000 10 padm
1,00,00,00,00,00,00,00,000 1 shankh
10,00,00,00,00,00,00,00,000 10 shankh
1,00,00,00,00,00,00,00,00,000 1 samudra
10,00,00,00,00,00,00,00,00,000 10 samudra
1,00,00,00,00,00,00,00,00,00,000 1 antya
10,00,00,00,00,00,00,00,00,00,000 10 antya

Kindly help me to modify this code.

Bob Phillips
2012-04-02, 08:51 AM
Here is a version I wrote some time ago.

Use as =SPELLNUMBER(A2,False)



Function SpellNumber(ByVal MyNumber, Optional incRupees As Boolean = True)
Dim Crores, Lakhs, Rupees, Paise, Temp
Dim DecimalPlace As Long, Count As Long
Dim myLakhs, myCrores
ReDim Place(9) As String
Place(2) = " Thousand ": Place(3) = " Million "
Place(4) = " Billion ": Place(5) = " Trillion "
' String representation of amount.
MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")
' Convert Paise and set MyNumber to Rupees amount.
If DecimalPlace > 0 Then
Paise = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
myCrores = MyNumber \ 10000000
myLakhs = (MyNumber - myCrores * 10000000) \ 100000
MyNumber = MyNumber - myCrores * 10000000 - myLakhs * 100000
Count = 1
Do While myCrores <> ""
Temp = GetHundreds(Right(myCrores, 3))
If Temp <> "" Then Crores = Temp & Place(Count) & Crores
If Len(myCrores) > 3 Then
myCrores = Left(myCrores, Len(myCrores) - 3)
Else
myCrores = ""
End If
Count = Count + 1
Loop
Count = 1
Do While myLakhs <> ""
Temp = GetHundreds(Right(myLakhs, 3))
If Temp <> "" Then Lakhs = Temp & Place(Count) & Lakhs
If Len(myLakhs) > 3 Then
myLakhs = Left(myLakhs, Len(myLakhs) - 3)
Else
myLakhs = ""
End If
Count = Count + 1
Loop
Count = 1
Do While MyNumber <> ""
Temp = GetHundreds(Right(MyNumber, 3))
If Temp <> "" Then Rupees = Temp & Place(Count) & Rupees
If Len(MyNumber) > 3 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
Else
MyNumber = ""
End If
Count = Count + 1
Loop
Select Case Crores
Case "": Crores = ""
Case "One": Crores = " One Crore "
Case Else: Crores = Crores & " Crores "
End Select
Select Case Lakhs
Case "": Lakhs = ""
Case "One": Lakhs = " One Lakh "
Case Else: Lakhs = Lakhs & " Lakhs "
End Select
Select Case Rupees
Case "": Rupees = "Zero "
Case "One": Rupees = "One "
Case Else:

Rupees = Rupees
End Select
Select Case Paise
Case "": Paise = " and Paise Zero Only "
Case "One": Paise = " and Paise One Only "
Case Else: Paise = " and Paise " & Paise & " Only "
End Select
SpellNumber = IIf(incRupees, "Rupees ", "") & Crores & _
Lakhs & Rupees & Paise
End Function
' Converts a number from 100-999 into text
Function GetHundreds(ByVal MyNumber)
Dim Result As String
If Val(MyNumber) = 0 Then Exit Function
MyNumber = Right("000" & MyNumber, 3)
' Convert the hundreds place.
If Mid(MyNumber, 1, 1) <> "0" Then
Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
End If
' Convert the tens and ones place.
If Mid(MyNumber, 2, 1) <> "0" Then
Result = Result & GetTens(Mid(MyNumber, 2))
Else
Result = Result & GetDigit(Mid(MyNumber, 3))
End If
GetHundreds = Result
End Function
' Converts a number from 10 to 99 into text.
Function GetTens(TensText)
Dim Result As String
Result = "" ' Null out the temporary function value.
If Val(Left(TensText, 1)) = 1 Then ' If value between 10-19...
Select Case Val(TensText)
Case 10: Result = "Ten"
Case 11: Result = "Eleven"
Case 12: Result = "Twelve"
Case 13: Result = "Thirteen"
Case 14: Result = "Fourteen"
Case 15: Result = "Fifteen"
Case 16: Result = "Sixteen"
Case 17: Result = "Seventeen"
Case 18: Result = "Eighteen"
Case 19: Result = "Nineteen"
Case Else
End Select
Else ' If value between 20-99...
Select Case Val(Left(TensText, 1))
Case 2: Result = "Twenty "
Case 3: Result = "Thirty "
Case 4: Result = "Forty "
Case 5: Result = "Fifty "
Case 6: Result = "Sixty "
Case 7: Result = "Seventy "
Case 8: Result = "Eighty "
Case 9: Result = "Ninety "
Case Else
End Select
Result = Result & GetDigit _
(Right(TensText, 1)) ' Retrieve ones place.
End If
GetTens = Result
End Function
' Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
Select Case Val(Digit)
Case 1: GetDigit = "One"
Case 2: GetDigit = "Two"
Case 3: GetDigit = "Three"
Case 4: GetDigit = "Four"
Case 5: GetDigit = "Five"
Case 6: GetDigit = "Six"
Case 7: GetDigit = "Seven"
Case 8: GetDigit = "Eight"
Case 9: GetDigit = "Nine"
Case Else: GetDigit = ""
End Select
End Function

khokababu
2012-04-02, 01:01 PM
Thanks for the reply. The code is correct for the counting of currency but I do not want Rupees and paisa inbeetween
I want only the Numerical to word. Can you help in modifying this code.

Bob Phillips
2012-04-02, 06:58 PM
Rupees is already catered for, the ,,False in the formula.

Ken Puls
2012-04-02, 07:08 PM
kohkababu,

=SpellNumber(12345687) gives you "Rupees One Crore Twenty Three Lakhs Forty Five Thousand Six Hundred Eighty Seven and Paise Zero Only"
=SpellNumber(12345687,False) gives you "One Crore Twenty Three Lakhs Forty Five Thousand Six Hundred Eighty Seven and Paise Zero Only"

Bob, that's very cool. Can I make that an article on the site? (Under your name, of course.)

khokababu
2012-04-02, 07:23 PM
Dear thanks. One more request if I do not want paisa also only the spelling of the number Example 234565 (Two Lac thirty four thousand five hundred sixty five only). Remember "only" should be there, them what rectification I have to do in this particular code.

Ken Puls
2012-04-02, 07:29 PM
Modify:

Select Case Paise
Case "": Paise = " and Paise Zero Only "
Case "One": Paise = " and Paise One Only "
Case Else: Paise = " and Paise " & Paise & " Only "
End Select

To this:

Select Case Paise
Case "": Paise = " and Zero Only "
Case "One": Paise = " and One Only "
Case Else: Paise = " and " & Paise & " Only "
End Select

Bob Phillips
2012-04-02, 11:39 PM
Bob, that's very cool. Can I make that an article on the site? (Under your name, of course.)

This is an old one Ken, I modified a generic SpellNumber function after a request to have it in Indian notation back in the old Usenet NG days, but feel free to use it.