VBA-Excel: Convert Numbers (Rupees) into Words OR Text – Updated Till 1000000 Crore With Decimal Numbers

To Convert Numbers into Text, please follow the steps below

Download Link: NumberToWords
Example:

1000000000.00 Rupees One Hundred Crores
345.56 Rupees Three Hundred Fourty Five and Fifty Six paise only
12312312.00 Rupees One Crore Twenty Three Lacs Twelve Thousand Three Hundred Twelve
999999999.00 Rupees Ninty Nine Crores Ninty Nine Lacs Ninty Nine Thousand Nine Hundred Ninty Nine
9999999999.00 Rupees Nine Hundred Ninty Nine Crores Ninty Nine Lacs Ninty Nine Thousand Nine Hundred Ninty Nine
1212.34 Rupees One Thousand Two Hundred Twelve and Thirty Four paise only
23231111.00 Rupees Two Crore Thirty Two Lacs Thirty One Thousand One Hundred Eleven

 Steps:

  • Open a new WorkBook
  • Create a Button
  • Copy Paste the Complete Code
  • Assign the macro to the button created
  • Write the Number in Column A
  • Click the Convert button
  • You will find the text of number in column B

Complete Code:


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

Download Link : NumberToWords

Convert Number to Words
Convert Number to Words