Log In
Register
Home
Active Member
July 24, 2019
Offline
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
See Answer
November 8, 2013
Offline
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/Show.....sp?ID=7814
https://excel-macro.tutorialho.....into-text/
Looks like there is already an adapted version of Phil's code here: https://exceldatapro.com/spell.....an-rupees/
Without a reference to the original code creator, of course...
Active Member
July 24, 2019
Offline
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
1 Guest(s)
