converting Figures to words it seems correction required

N

NimishK

Well-known Member
Joined
Sep 4, 2015
Messages
688
Hi anyone your help will be appreciated

Though adopted the code from below link for converting form figures to words
It seems there is error some how not able to get it right
http://excel-macro.tutorialhorizon.com/vba-excel-convert-numbers-rupees-into-text/

when i type in Textboxfigure.text = 10 or 10.00
I get as Rupees 10 and Paise only where as i would like the desired result to be Rupees Ten Only

Similarly when i type 0.25 i get
Rupees and Twenty Five Paise Only were as i would like to get as Twenty Five Paise only

what corrections needs to be done in the following code
Below is code adopted from

http://excel-macro.tutorialhorizon.com/vba-excel-convert-numbers-rupees-into-text/

Code: 
Function FnConvert(strNumber)

    blnDecimalExist = False
    strNumber = CStr(strNumber)
    
    If InStr(1, strNumber, ".", vbTextCompare) > 0 Then
        arrSplit = Split(strNumber, ".")
        strNumber = arrSplit(0)
        strDecimal = arrSplit(1)
        
        If Len(strDecimal) > 2 Then
            strDecimal = Mid(strDecimal, 0, 2)
        End If
         
        If Len(strDecimal) > 0 And Len(strDecimal) < 2 Then
            strDecimalConversion = FnGetUnitDigit(strDecimal)
        End If
        If Len(strDecimal) > 1 And Len(strDecimal) < 3 Then
            strDecimalConversion = FnGetTensDigit(strDecimal)
        End If
        
        blnDecimalExist = True
        
    End If
    
    If Len(strNumber) > 0 And Len(strNumber) < 2 Then
        strTextConversion = FnGetUnitDigit(strNumber)
    End If
    If Len(strNumber) > 1 And Len(strNumber) < 3 Then
        strTextConversion = FnGetTensDigit(strNumber)
    End If
    If Len(strNumber) > 2 And Len(strNumber) < 4 Then
        strTextConversion = FnGetHundreds(strNumber)
    End If
    If Len(strNumber) > 3 And Len(strNumber) < 6 Then
        If Len(strNumber) = 4 Then
            strTextConversion = FnGetThousandsOne(strNumber)
        End If
        If Len(strNumber) = 5 Then
            strTextConversion = FnGetThousandsTwo(strNumber)
        End If
    End If
     If Len(strNumber) > 5 And Len(strNumber) < 8 Then
       If Len(strNumber) = 6 Then
            strTextConversion = FnGetLacsOne(strNumber)
        End If
        If Len(strNumber) = 7 Then
            strTextConversion = FnGetLacsTwo(strNumber)
        End If
    End If
    If Len(strNumber) > 7 And Len(strNumber) < 15 Then
       If Len(strNumber) = 8 Then
            strTextConversion = FnGetCroreOne(strNumber)
        End If
        If Len(strNumber) = 9 Then
            strTextConversion = FnGetCroreTwo(strNumber)
        End If
        If Len(strNumber) = 10 Then
            strTextConversion = FnGetCroreThree(strNumber)
        End If
        If Len(strNumber) = 11 Then
            strTextConversion = FnGetCroreFour(strNumber)
        End If
        If Len(strNumber) = 12 Then
            strTextConversion = FnGetCroreFive(strNumber)
        End If
        If Len(strNumber) = 13 Then
            strTextConversion = FnGetCroreSix(strNumber)
        End If
        If Len(strNumber) = 14 Then
            strTextConversion = FnGetCroreSeven(strNumber)
        End If
    End If
    
    
    If blnDecimalExist Then
        strTextConversion = "Rupees " & strTextConversion & " and " & strDecimalConversion & " paise only"
    Else
        strTextConversion = "Rupees " & strTextConversion
    End If
    FnConvert = strTextConversion
End Function
Function FnGetCroreSeven(intN)
    Dim Str
    
    'temp = FnGetTensDigit(Left(intN, 3))
    'If temp <> "" Then
        Str = FnGetLacsTwo(Left(intN, 7)) & " Crores " & FnGetLacsTwo(Right(intN, Len(intN) - 7))
    'Else
     '   Str = FnGetLacsTwo(Right(intN, Len(intN) - 3))
    'End If
    FnGetCroreSeven = Str
End Function


Function FnGetCroreSix(intN)
    Dim Str
    
    'temp = FnGetTensDigit(Left(intN, 3))
    'If temp <> "" Then
        Str = FnGetLacsOne(Left(intN, 6)) & " Crores " & FnGetLacsTwo(Right(intN, Len(intN) - 6))
    'Else
     '   Str = FnGetLacsTwo(Right(intN, Len(intN) - 3))
    'End If
    FnGetCroreSix = Str
End Function


Function FnGetCroreFive(intN)
    Dim Str
    
    'temp = FnGetTensDigit(Left(intN, 3))
    'If temp <> "" Then
        Str = FnGetThousandsTwo(Left(intN, 5)) & " Crores " & FnGetLacsTwo(Right(intN, Len(intN) - 5))
    'Else
     '   Str = FnGetLacsTwo(Right(intN, Len(intN) - 3))
    'End If
    FnGetCroreFive = Str
End Function


Function FnGetCroreFour(intN)
    Dim Str
    
    'temp = FnGetTensDigit(Left(intN, 3))
    'If temp <> "" Then
        Str = FnGetThousandsOne(Left(intN, 4)) & " Crores " & FnGetLacsTwo(Right(intN, Len(intN) - 4))
    'Else
     '   Str = FnGetLacsTwo(Right(intN, Len(intN) - 3))
    'End If
    FnGetCroreFour = Str
End Function


Function FnGetCroreThree(intN)
    Dim Str
    
    'temp = FnGetTensDigit(Left(intN, 3))
    'If temp <> "" Then
        Str = FnGetHundreds(Left(intN, 3)) & " Crores " & FnGetLacsTwo(Right(intN, Len(intN) - 3))
    'Else
     '   Str = FnGetLacsTwo(Right(intN, Len(intN) - 3))
    'End If
    FnGetCroreThree = Str
End Function


Function FnGetCroreTwo(intN)
    Dim Str
    
    temp = FnGetTensDigit(Left(intN, 2))
    If temp <> "" Then
        Str = FnGetTensDigit(Left(intN, 2)) & " Crores " & FnGetLacsTwo(Right(intN, Len(intN) - 2))
    Else
        Str = FnGetLacsTwo(Right(intN, Len(intN) - 2))
    End If
    
    FnGetCroreTwo = Str
End Function


Function FnGetCroreOne(intN)
    Dim Str
     
    temp = FnGetUnitDigit(Left(intN, 1))
    If temp <> "" Then
        Str = FnGetUnitDigit(Left(intN, 1)) & " Crore " & FnGetLacsTwo(Right(intN, Len(intN) - 1))
    Else
        Str = FnGetLacsTwo(Right(intN, Len(intN) - 1))
    End If
    
     FnGetCroreOne = Str
End Function
Function FnGetLacsTwo(intN)
    Dim Str
    
    temp = FnGetTensDigit(Left(intN, 2))
    If temp <> "" Then
        Str = FnGetTensDigit(Left(intN, 2)) & " Lacs " & FnGetThousandsTwo(Right(intN, Len(intN) - 2))
    Else
        Str = FnGetThousandsTwo(Right(intN, Len(intN) - 2))
    End If
    
    FnGetLacsTwo = Str
End Function
Function FnGetLacsOne(intN)
    Dim Str
     'Str = FnGetUnitDigit(Left(intN, 1)) & " Lac " & FnGetThousandsTwo(Right(intN, Len(intN) - 1))
     
    temp = FnGetUnitDigit(Left(intN, 1))
    If temp <> "" Then
        Str = FnGetUnitDigit(Left(intN, 1)) & " Lac " & FnGetThousandsTwo(Right(intN, Len(intN) - 1))
    Else
        Str = FnGetThousandsTwo(Right(intN, Len(intN) - 1))
    End If
    
    
     FnGetLacsOne = Str
End Function
Function FnGetThousandsTwo(intN)
    Dim Str
    'Str = FnGetTensDigit(Left(intN, 2)) & " Thousand " & FnGetHundreds(Right(intN, Len(intN) - 2))
    
    temp = FnGetTensDigit(Left(intN, 2))
    If temp <> "" Then
        Str = FnGetTensDigit(Left(intN, 2)) & " Thousand " & FnGetHundreds(Right(intN, Len(intN) - 2))
    Else
        Str = FnGetHundreds(Right(intN, Len(intN) - 2))
    End If
    
    
    FnGetThousandsTwo = Str
End Function
Function FnGetThousandsOne(intN)
    Dim Str
    'Str = FnGetUnitDigit(Left(intN, 1)) & " Thousand " & FnGetHundreds(Right(intN, Len(intN) - 1))
    
    temp = FnGetUnitDigit(Left(intN, 1))
    If temp <> "" Then
        Str = FnGetUnitDigit(Left(intN, 1)) & " Thousand " & FnGetHundreds(Right(intN, Len(intN) - 1))
    Else
        Str = FnGetHundreds(Right(intN, Len(intN) - 1))
    End If
    
    FnGetThousandsOne = Str
End Function
Function FnGetHundreds(intN)
    Dim Str
    temp = FnGetUnitDigit(Left(intN, 1))
    If temp <> "" Then
        Str = FnGetUnitDigit(Left(intN, 1)) & " Hundred " & FnGetTensDigit(Right(intN, 2))
    Else
        Str = FnGetTensDigit(Right(intN, 2))
    End If
    
    FnGetHundreds = Trim(Str)
End Function
Function FnGetTensDigit(intN)
    Dim Str
    If Left(intN, 1) = 1 Then
       Select Case Val(intN)
            Case 10: Str = "Ten"
            Case 11: Str = "Eleven"
            Case 12: Str = "Twelve"
            Case 13: Str = "Thirteen"
            Case 14: Str = "Fourteen"
            Case 15: Str = "Fifteen"
            Case 16: Str = "Sixteen"
            Case 17: Str = "Seventeen"
            Case 18: Str = "Eighteen"
            Case 19: Str = "Nineteen"
        End Select
    Else
        Select Case Val(Left(intN, 1))
            Case 2: Str = "Twenty"
            Case 3: Str = "Thirty"
            Case 4: Str = "Fourty"
            Case 5: Str = "Fifty"
            Case 6: Str = "Sixty"
            Case 7: Str = "Seventy"
            Case 8: Str = "Eighty"
            Case 9: Str = "Ninty"
        End Select
        
        Str = Str & " " & FnGetUnitDigit(Right(intN, 1))
    End If
    
    FnGetTensDigit = Trim(Str)
End Function
Function FnGetUnitDigit(intN)


    Dim Str


    Select Case Val(intN)
        Case 1: Str = "One"
        Case 2: Str = "Two"
        Case 3: Str = "Three"
        Case 4: Str = "Four"
        Case 5: Str = "Five"
        Case 6: Str = "Six"
        Case 7: Str = "Seven"
        Case 8: Str = "Eight"
        Case 9: Str = "Nine"
    End Select
        FnGetUnitDigit = Trim(Str)
End Function

in Textbox code
Code: 
 Private Sub textboxFigure_Change() 
  
 If textboxFigure.Text = "" Then
    textboxWords.Text = ""
  Else
    textboxWords.Text = FnConvert(Format(textboxFigure.Text, "#.##"))
  End If


End Sub

Regards
NimishK
 
Last edited:

Excel Facts

Remove leading & trailing spaces
Save as CSV to remove all leading and trailing spaces. It is faster than using TRIM().
Sort by date Sort by votes
Revised code

'Change this


Code: 
If blnDecimalExist Then
        strTextConversion = "Rupees " & strTextConversion & " and " & strDecimalConversion & " paise only"
    Else
        strTextConversion = "Rupees " & strTextConversion
    End If
'Change as


Code: 
 If blnDecimalExist Then
    
 If strTextConversion <> "" Then
    If strDecimalConversion <> "" Then
    strTextConversion = strTextConversion & "Rupees and " & strDecimalConversion & " paise only"
    Else
    strTextConversion = strTextConversion & "Rupees only"
    End If
Else
    If strDecimalConversion <> "" Then
    strTextConversion = strDecimalConversion & " paise only"
    Else
    strTextConversion = ""
    End If
End If
End If
 
Upvote 0
Thanks Kvsrinvasmurthyji

Really appreciate your help

unfortunately 5.20 reads as Five Rupees and Two paise only instead of Five Rupees and Twenty paise

It seems correction is required

NimishK
 
Upvote 0
Anyone
It seems there is Correction required in the following Thread
http://excel-macro.tutorialhorizon.c...ees-into-text/

0.10 converts as One instead of Ten
0.20 converts as Two instead of Twenty
0.30 converts as Three instead of Thirty
0.40 converts as Four instead of Forty
0.50 converts as Five instead of Fifty
0.60 converts as Six instead of Sixty
0.70 converts as Seven instead of Seventy
0.80 converts as Eight instead of Eighty
0.90 converts as Nine instead of Eighty

But
0.01 converts as One ----> Correct
0.02 converts as Two ----> Correct
0.03 converts as Three ----> Correct
0.04 converts as Four ----> Correct
0.05 converts as Five ----> Correct
0.06 converts as Six ----> Correct
0.07 converts as Seven ----> Correct
0.08 converts as Eight ----> Correct
0.09 converts as Nine ----> Correct
and from 0.11 to 0.19 it converts correctly Also 0.22 converts correctly as Twenty Two and 0.56 also converts as Fifty Six correctly

Whats needs to be done here ?
Code: 
If Len(strDecimal) > 2 Then
            strDecimal = Mid(strDecimal, 0, 2)
        End If
         
        If Len(strDecimal) > 0 And Len(strDecimal) < 2 Then
            strDecimalConversion = FnGetUnitDigit(strDecimal)
        End If
        If Len(strDecimal) > 1 And Len(strDecimal) < 3 Then
            strDecimalConversion = FnGetTensDigit(strDecimal)
        End If
 End If
Thanks
NimishK
 
Last edited:
Upvote 0
Can anyone help or refer the thread who has worked and overcome the above error as per post 4
 
Upvote 0
Re: Excel does not recognise the figure of Zero at the unit place with Tens

In your Format function call, using a # means you get a number in the location it is at only if there is any digit to fill it when there is another digit following it, but if the # being filled is at the end of the number and after the decimal point, only a non-zero digit can fill it. If you want to force trailing zeroes, use 0 instead of #.

Amounted$ = Format(UserForm1.TextBox1.Text, "0.00")
 
Last edited:
Upvote 0
Re: Excel does not recognise the figure of Zero at the unit place with Tens

Dear Rick

Whether Amounted$ = Format(UserForm1.TextBox1.Text, "0.00") or Amounted$ = Format(UserForm1.TextBox1.Text, "#.##")
the Zero in Units place does not recognises at all and therefore it misses.
Actually
Amounted$ = Format(UserForm1.TextBox1.Text, "0.00") i purposely incorporated to check for the desired result.
There should be no error at all with using Format or not using Format.
 
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question Question
Using VBA code in a protected excel sheet
Replies
2
Views
547
MagicCarpet
M
M
  • Question Question
Not running code
Replies
0
Views
218
MagicCarpet
M
MyHanhCB
  • Question Question
Editing the lookup function for each argument.
Replies
4
Views
311
MyHanhCB
MyHanhCB
G
  • Solved
run VBA when clicked
Replies
4
Views
185
Gylle
G
X
  • Question Question
Locking/unlocking a cell with a Combo Box value Mouse click problem
Replies
0
Views
770
XrayLemi
X

Forum statistics

Threads
1,224,823
Messages
6,181,185
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top