Consulting

Results 1 to 9 of 9

Thread: Solved: convert numerical value to other text format

  1. #1
    VBAX Regular
    Joined
    Oct 2005
    Posts
    20
    Location

    Solved: convert numerical value to other text format

    Hi,
    I need to convert numerical value to following text format:
    5 = five
    15 = fifteen
    327 = three hundred twenty seven
    2,980 = two thousand nine hundred eighty
    67,569 = sixty seven thousand five hundred sixty nine
    2,87,456 = two lacs eighty seven thousand four hundred fifty six
    43,09,125 = forty three lacs nine thousand one hundred twenty five
    1,61,02,779 = one crore sixty one lacs two thousand seven hundred seventy nine
    34,80,21,455 = thirty four crore eighty lacs twenty one thousand four hundred fifty five
    I wish to modify the following VB code taken from a FORUM in above fomat :

    [VBA]Option Explicit

    Function SpellNumber(ByVal MyNumber)
    'Main Function
    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 & Cents
    End Function
    Function GetHundreds(ByVal MyNumber)
    ' Converts a number from 100-999 into text
    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

    Function GetTens(TensText)
    ' Converts a number from 10 to 99 into text.
    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

    ' Retrieve ones place.
    Result = Result & GetDigit(Right(TensText, 1))
    End If

    GetTens = Result
    End Function

    Function GetDigit(Digit)
    ' Converts a number from 1 to 9 into text.
    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[/VBA]

    I don?t know VB coding, please if anyone can help me, it will be a great time saving process for me. Thanks!!!

    Regards

    Garima
    Last edited by geekgirlau; 10-23-2005 at 12:54 AM. Reason: Put line breaks in code

  2. #2
    Administrator
    VP-Knowledge Base
    VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Hi,
    I adapted this code from here http://www.vbaexpress.com/kb/getarticle.php?kb_id=285

    Because of your commas in the number, column A has been set as text. It should be possible to split a regular "undivided" number in a similar fashion if this is required.
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  3. #3
    VBAX Regular
    Joined
    Oct 2005
    Posts
    20
    Location
    Hi

    I am very thankfull to you. You have helped me to save my lot of time in this process.
    Thanks a lot for your very quick reply.

    With Regards

    Garima

  4. #4
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Happy to help Garima,
    If the answer is complete, you can mark this "solved" using the Thread Tools button, otherwise let us know if we can assist further.
    Regards
    MD
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  5. #5
    VBAX Regular
    Joined
    Oct 2005
    Posts
    20
    Location
    Hi

    Code is working in your file but when I copied and compiled it to my file it didn't work. Do I need to add some refrences in VB tool menu.

    Thanks

    Garima

  6. #6
    Moderator VBAX Wizard lucas's Avatar
    Joined
    Jun 2004
    Location
    Tulsa, Oklahoma
    Posts
    7,323
    Location
    I hope I'm not pointing out the obvious but you also have to add the calls to the functions in your spreadsheet....look in column B of Malcolms example. Should look like this:
    =NumberToText(A4)
    and refers to the column to its left.
    Steve
    "Nearly all men can stand adversity, but if you want to test a man's character, give him power."
    -Abraham Lincoln

  7. #7
    Administrator
    VP-Knowledge Base VBAX Grand Master mdmackillop's Avatar
    Joined
    May 2004
    Location
    Scotland
    Posts
    14,489
    Location
    Hi Garima,
    No unusual reference, see below.
    Number cells must be formatted as text.
    Number must contain commas between pairs of numbers before the hundreds
    MVP (Excel 2008-2010)

    Post a workbook with sample data and layout if you want a quicker solution.


    To help indent your macros try Smart Indent

    Please remember to mark threads 'Solved'

  8. #8
    Moderator VBAX Master geekgirlau's Avatar
    Joined
    Aug 2004
    Location
    Melbourne, Australia
    Posts
    1,464
    Location
    Hi Garima,

    I've just edited your post to put VBA tags around the code - makes it easier to read. You can do this by selecting your code and clicking on the "VBA" button.

  9. #9
    Distinguished Lord of VBAX VBAX Grand Master Bob Phillips's Avatar
    Joined
    Apr 2005
    Posts
    25,443
    Location
    Quote Originally Posted by 070968
    Hi

    Code is working in your file but when I copied and compiled it to my file it didn't work. Do I need to add some refrences in VB tool menu.
    The solution provided seems to depend upon the amount being text with the correct Indian format. It doesn't work on real numbers.

    Here is a version I wrote some time ago that works on numbers
    =SPELLNUMBER(A1)
    or
    =SPELLNUMBER(A1,False)

    if you don't want to start with Rupees

    [VBA]
    Option Explicit

    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
    [/VBA]
    ____________________________________________
    Nihil simul inventum est et perfectum

    Abusus non tollit usum

    Last night I dreamed of a small consolation enjoyed only by the blind: Nobody knows the trouble I've not seen!
    James Thurber

Posting Permissions

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