Editing VB code- Spellnumber Function

Thanks Thanks:  0
Likes Likes:  0
Results 1 to 6 of 6

Thread: Editing VB code- Spellnumber Function

  1. #1
    New Member
    Join Date
    Apr 2003
    Posts
    32
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Editing VB code- Spellnumber Function

     
    hi

    I have got the Spell number function VB macro code from you link site.
    But now i have edited the same for Indian Rupee coversion as

    Option Explicit
    'Main Function
    Function SpellNumber(ByVal MyNumber)
    Dim rupees, paise, Temp
    Dim DecimalPlace, Count
    ReDim Place(9) As String
    Place(2) = " Thousand "
    Place(3) = " Lakh "
    Place(4) = " Crores "
    Place(5) = " Million"
    ' String representation of amount.
    MyNumber = Trim(Str(MyNumber))
    ' Position of decimal place 0 if none.
    DecimalPlace = InStr(MyNumber, ".")
    ' Convert paise and set MyNumber to dollar amount.
    If DecimalPlace > 0 Then
    paise = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
    "00", 2))
    MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
    End If
    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 rupees
    Case ""
    rupees = "No rupees"
    Case "One"
    rupees = "One Dollar"
    Case Else
    rupees = rupees & " rupees"
    End Select
    Select Case paise
    Case ""
    paise = " and No paise"
    Case "One"
    paise = " and One Cent"
    Case Else
    paise = " and " & paise & " paise"
    End Select
    SpellNumber = 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

    Now if i enter 5,00,000, it spells as Five hundred Thousand Rupees.
    But what i need is Five Lakh Rupees.
    Now if i add another zero as 50,00,000, it spells as Five Lakh Rupees
    But what i need is Fifty Lakh rupees.
    Only one digit is going wrong. I don't know where to edit.
    Can anyone help me out?

  2. #2
    Board Regular
    Join Date
    May 2003
    Location
    Katy, Texas
    Posts
    3,829
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Editing VB code- Spellnumber Function

    You stated:

    "Now if i enter 5,00,000, it spells as Five hundred Thousand Rupees.
    But what i need is Five Lakh Rupees.
    Now if i add another zero as 50,00,000, it spells as Five Lakh Rupees
    But what i need is Fifty Lakh rupees.
    Only one digit is going wrong. I don't know where to edit. "


    The first question I have is:

    You use 5,00,000 and get Five hyndred Thousand Ruppees, but you expect Five Lakh Rupees as the answer. Have you tried using 5,000,000 instead?

    You use 50,00,000 and get Five Lakh Rupees, but you expect Five Lakh Rupees as the answer. Have you tried using 50,000,000 instead?

  3. #3
    Board Regular Egress1's Avatar
    Join Date
    Mar 2003
    Location
    Lubbock, Texas
    Posts
    420
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Editing VB code- Spellnumber Function

    "Now if i enter 5,00,000, it spells as Five hundred Thousand Rupees.
    But what i need is Five Lakh Rupees.
    Now if i add another zero as 50,00,000, it spells as Five Lakh Rupees
    But what i need is Fifty Lakh rupees."

    Forgvie me if I'm wrong on this as I do not know a thing about Rupees but do you really mean to type "5,00,000" as opposed to "500,000"? and "50,00,000" as opposed to "50,000,000"?
    Ken

  4. #4
    MrExcel MVP
    Join Date
    Mar 2002
    Location
    Michigan USA
    Posts
    11,454
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Editing VB code- Spellnumber Function

    Hi suriya6in:

    Please look at the following simulation that spells out a string in Indian Rupees and Paise ...

    ******** ******************** ************************************************************************>
    Microsoft Excel - y021120h1.xls___Running: xl97 : OS = Windows 98
    (F)ile (E)dit (V)iew (I)nsert (O)ptions (T)ools (D)ata (W)indow (H)elp (A)bout
    =

    A
    B
    C
    D
    1
    2
    11111111111.11Eleven Arab Eleven Crore Eleven Lac Eleven Thousand One Hundred Eleven Rupees and Eleven Paise
    3
    Rupees

    [HtmlMaker 2.20] To see the formula in the cells just click on the cells hyperlink or click the Name box
    PLEASE DO NOT QUOTE THIS TABLE IMAGE ON SAME PAGE! OTHEWISE, ERROR OF JavaScript OCCUR.


    You may want to look at the following ySpellRupees UDF that I had posted in response to a request from a fellow Excel enthusiast Vipul in India -- the UDF is based on SpellNUmber UDF by Microsoft ...
    Code:
    '**** ySpellRupees
    '**** Yogi Anand -- ANAND Enterprises -- Rochester Hills MI 48309 -- 248-375-5710
    '**** Excel UDF to spell Indian Currency -- Rupees and Paise into text
    '**** Indian currency starts off with 1000s, and after that only with 100s
    '**** 1000 (Thousand) -- 1,00,000 (Lac or Lakh) -- 1,00,00,000 (Crore) -- 1,00,00,00,000 (Arab)
    '**** (this UDF is based on SpellNumber by Microsoft)
    '****************' Main Function *'****************
    Function ySpellRupees(ByVal MyNumber)
        Dim Rupees, Paise, Temp
        Dim DecimalPlace, Count
        ReDim Place(9) As String
            Place(2) = " Thousand "
            Place(3) = " Lac "
            Place(4) = " Crore "
            Place(5) = " Arab " ' String representation of amount
            MyNumber = Trim(Str(MyNumber)) ' Position of decimal place 0 if none
            DecimalPlace = InStr(MyNumber, ".")
            'Convert Paise and set MyNumber to Rupee amount
            If DecimalPlace > 0 Then
                Paise = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
                MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
            End If
            Count = 1
            Do While MyNumber <> ""
                If Count = 1 Then Temp = GetHundreds(Right(MyNumber, 3))
                If Count > 1 Then Temp = GetHundreds(Right(MyNumber, 2))
                If Temp <> "" Then Rupees = Temp & Place(Count) & Rupees
                If Count = 1 And Len(MyNumber) > 3 Then
                MyNumber = Left(MyNumber, Len(MyNumber) - 3)
                Else
                    If Count > 1 And Len(MyNumber) > 2 Then
                    MyNumber = Left(MyNumber, Len(MyNumber) - 2)
                    Else
                        MyNumber = ""
                    End If
                End If
                Count = Count + 1
            Loop
            Select Case Rupees
                Case ""
                    Rupees = "No Rupees"
                Case "One"
                    Rupees = "One Rupee"
                Case Else
                    Rupees = Rupees & " Rupees"
            End Select
            Select Case Paise
                Case ""
                    Paise = " and No Paise"
                Case "One"
                    Paise = " and One Paisa"
                Case Else
                    Paise = " and " & Paise & " Paise"
            End Select
        ySpellRupees = 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
    I hope this helps. If I have misunderstood your question, my apologies.
    Regards!

    Yogi Anand, D.Eng, P.E.
    Energy Efficient Building Network LLC
    www.energyefficientbuild.com

  5. #5
    New Member
    Join Date
    Jun 2010
    Posts
    1
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Editing VB code- Spellnumber Function

    How to use this formula in excel were to past this pls help in detail

  6. #6
    New Member
    Join Date
    May 2013
    Posts
    1
    Post Thanks / Like
    Mentioned
    0 Post(s)
    Tagged
    0 Thread(s)

    Default Re: Editing VB code- Spellnumber Function

      
    Good Evening Guys, I had added the following code into vba and it works perfectly. Code:
    Option Explicit'Main FunctionFunction SpellNumber(ByVal MyNumber) Dim Dollars, Cents, Temp Dim DecimalPlace, Count 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 cents and set MyNumber to dollar amount. If DecimalPlace > 0 Then Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _ "00", 2)) MyNumber = Trim(Left(MyNumber, DecimalPlace - 1)) End If Count = 1 Do While MyNumber <> "" Temp = GetHundreds(Right(MyNumber, 3)) If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars If Len(MyNumber) > 3 Then MyNumber = Left(MyNumber, Len(MyNumber) - 3) Else MyNumber = "" End If Count = Count + 1 Loop Select Case Dollars Case "" Dollars = "No Dollars" Case "One" Dollars = "One Dollar" Case Else Dollars = Dollars & " Dollars" End Select Select Case Cents Case "" Cents = " and No Cents" Case "One" Cents = " and One Cent" Case Else Cents = " and " & Cents & " Cents" End Select SpellNumber = Dollars & CentsEnd 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 = ResultEnd 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 = ResultEnd 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 SelectEnd Function
    After the modification it shows "#name?". I tried to undo everything and i even tried re-paste the original code again, but the function will never work again. I can't just create another worksheet as i had adjusted the alignment for check printing purpose. I need to get the function back on work even without the modification required. Can anyone assist please? Regards Parker
    Last edited by zidparker; May 20th, 2013 at 11:46 AM.

User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

 

 
DMCA.com