Forum

Customized Conversi...
 
Notifications
Clear all

Customized Conversion Indian Currency to Words With Excel VBA (Request)

5 Posts
2 Users
0 Reactions
198 Views
(@excelled)
Posts: 3
Active Member
Topic starter
 

Can you please make a code for Indian Rupees in Whole numbers? Please note that Trillion, Million and Billion is not used in Indian Currency system. Comma for separation is also used in a different manner.

For example the number 1234567899000 in Rupees is written as ₹ 123456,78,99,000 in short and Rupees One Lakh Twenty Three Thousand Four Hundred Fifty Six Crore Seventy Eight Lakh Ninety Nine Thousand. Use of the word ‘Only’ at the end has become obsolete now-a-days.

Can you please post a code which converts ₹ 123456,78,99,000 to Rupees One Lakh Twenty Three Thousand Four Hundred Fifty Six Crore Seventy Eight Lakh Ninety Nine Thousand in words. The suffix 'only' is not needed.

Thanks in advance and Regards

 
Posted : 24/07/2019 10:09 am
(@catalinb)
Posts: 1937
Member Admin
 

Hi Ray,

There are already a few codes for that conversion. You should try them, it's much easier than writing a similar code from scratch, the codes to convert normal numbers to words cannot be converted to rupees.

http://www.freevbcode.com/ShowCode.asp?ID=7814

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

Looks like there is already an adapted version of Phil's code here: https://exceldatapro.com/spellnumber-indian-rupees/

Without a reference to the original code creator, of course...

 
Posted : 26/07/2019 11:33 am
(@excelled)
Posts: 3
Active Member
Topic starter
 

Hi Bomea,

It's really a great help. Thanks a lot. The code in the second link seems a close match. But unfortunately I do not want it with a conversion button. I liked the way Phil's code do, i.e. when I put the number in column A, the converted words will appear in column B. I don't know VBA coding. Can you please modify the following code so that there is no convert button and no 'Main Page' or 'Sheets' issue. It will  be as easy as putting the number in any cell in column A and get the result in corresponding cell in column B? Regards.

Sub sumit()

Dim mainWorkBook

Set mainWorkBook = ActiveWorkbook

intRows = mainWorkBook.Sheets("Main").UsedRange.Rows.Count
'MsgBox intRows
For i = 1 To intRows
intValue = mainWorkBook.Sheets("Main").Range("A" & i)
If intValue <> "" Then
mainWorkBook.Sheets("Main").Range("B" & i) = FnConvert(intValue)
End If
Next

 

End Sub
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

 
Posted : 27/07/2019 3:09 pm
(@catalinb)
Posts: 1937
Member Admin
 

You already have that. In column B, enter the function like this: =FnConvert(A1)

 
Posted : 27/07/2019 11:59 pm
(@excelled)
Posts: 3
Active Member
Topic starter
 

Thanks. I followed what you said and it's done.

 
Posted : 28/07/2019 10:21 am
Share: