Dear friends...
We often look / require a formula who can spell the
figures in text.
In most of the reports we prepare we require to
mentioned the figures / amount in text also. In some report this is mandatory
to mention the same in text like bank deposit slips, any reports prepared for government
department, etc etc.
But there is no such inbuilt formula in excel who can
do this automatically.
** But now we can do the same with a UDF (user defined
formula).
Let’s see how..
Copy and paste the following programme in the excel
module. Module??? Ohhh. For that
following the following steps: -
1.
Right click on any sheet and select View
Code
2.
In the top left of the window you will find
the list of sheets
3.
Right click on any sheet and then click
insert and then click module
4.
A module window will open.
Now copy paste the following codes into it.
Function SpellCurr(ByVal MyNumber, _
Optional MyCurrency As String = "Rupee", _
Optional MyCurrencyPlace As String = "P", _
Optional MyCurrencyDecimals As String =
"Paisa", _
Optional MyCurrencyDecimalsPlace As String =
"S")
Dim
Rupees, Paisa, Temp
Dim
DecimalPlace, Count
ReDim
Place(9) As String
Place(2) = " Thousand "
Place(3) = " Lakhs "
Place(4) = " Crore "
'String
representation of amount.
MyNumber = Trim(Str(MyNumber))
'Position of decimal place 0 if none.
DecimalPlace = InStr(MyNumber, ".")
'
Convert Paisa and set MyNumber to Rupee amount.
If
DecimalPlace > 0 Then
Paisa = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
"00", 2))
MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
End If
If
Len(Trim(Str(MyNumber))) Mod 2 = 0 Then
MyNumber = "0" & Trim(Str(MyNumber))
Else
MyNumber = Trim(Str(MyNumber))
End If
Count =
1
Do
While MyNumber <> ""
If
Count = 1 Or Count > 7 Then
Temp =
GetHundreds(Right(MyNumber, 3))
Else
Temp =
GetTens(Right(MyNumber, 2))
End If
If
Temp <> "" Then Rupees = Temp & Place(Count) & Rupees
If
Len(MyNumber) >= 1 And Count < 2 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 3)
ElseIf Len(MyNumber) >= 1 And Count > 1 Then
MyNumber = Left(MyNumber, Len(MyNumber) - 2)
Else
MyNumber = ""
End
If
Count = Count + 1
Loop
If
MyCurrencyPlace = "P" Then
Select Case Rupees
Case ""
Rupees = MyCurrency & "s" & " Zero"
Case "One"
Rupees = MyCurrency & " One"
Case Else
Rupees = MyCurrency & "s " & Rupees
End Select
Else
Select Case Rupees
Case ""
Rupees = "Zero " & MyCurrency & "s"
Case "One"
Rupees = "One " & MyCurrency
Case Else
Rupees = Rupees & " " & MyCurrency & "s"
End Select
End
If
If
MyCurrencyDecimalsPlace = "S" Then
Select Case Paisa
Case ""
Paisa = " Only"
Case "One"
Paisa = " and One "
& MyCurrencyDecimals & " Only"
Case Else
Paisa = " and " & Paisa & " " &
MyCurrencyDecimals & "s Only"
End Select
Else
Select Case Paisa
Case ""
Paisa = " Only"
Case "One"
Paisa = " and " & MyCurrencyDecimals & " One
" & " Only"
Case Else
Paisa = " and " &
MyCurrencyDecimals & "s " & Paisa & " Only"
End Select
End If
SpellCurr = Rupees & Paisa
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
Alternatively you can also download the code file by clicking the below link.
Click to download the Code file
Now save this and you have created a new formula for that particular file.
To use this you will have to type "=spellCurr(refer the cell address)"
Hope this is very simple and useful for all of you.
Cheers... Enjoy....
