Modification of user defined funtion

khokababu

New member
Joined
Apr 1, 2012
Messages
3
Reaction score
0
Points
0
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.
Code:
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.
 
Here is a version I wrote some time ago.

Use as =SPELLNUMBER(A2,False)

Code:
Function [B]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: 
[/B]
[B]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 
    [B]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
[/B][/B]
 
A little modification is required

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.
 
Rupees is already catered for, the ,,False in the formula.
 
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.)
 
How to omit Paisa also from the code

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.
 
Last edited:
Modify:
Code:
    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:
Code:
    Select Case Paise
        Case "": Paise = " and Zero Only "
        Case "One": Paise = " and One Only "
        Case Else: Paise = " and " & Paise & " Only "
    End Select
 
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.
 
Back
Top