Tuesday, 12 May 2015

Excel Function to Convert Rupee Amount to Text

Many time we need to get textual representation of Numerical Value. Many such functions are available through internet but for Indian system of Crore/Lakh/Hazar it is a bit rare.

Suppose you have 1234 and need it's textual representation. That is "One Thousand Two Hundred Thirty Four"

The function "TransferNumberToText" given below will help you in that case.

To know how to use custom function, you can refer
http://excelfeature.blogspot.in/2015/05/how-to-add-custom-function-in-excel.html

The limitations of this functions are :

It does not handle Negative Value or Decimal Value
It will not work for 100 Crore or more. (Just Kidding.. I am a poor person and this amount is too much for my function.)

.********************************************************************
Private Function TransferTen(numDasak As Byte) As String
    Select Case numDasak
        Case 1: TransferTen = "One"
        Case 2: TransferTen = "Two"
        Case 3: TransferTen = "Three"
        Case 4: TransferTen = "Four"
        Case 5: TransferTen = "Five"
        Case 6: TransferTen = "Six"
        Case 7: TransferTen = "Seven"
        Case 8: TransferTen = "Eight"
        Case 9: TransferTen = "Nine"
        Case Else: TransferTen = ""
    End Select
End Function
Private Function TenNineteen(num10_19 As Byte) As String
    Select Case num10_19
        Case 10: TenNineteen = "Ten"
        Case 11: TenNineteen = "Eleven"
        Case 12: TenNineteen = "Twelve"
        Case 13: TenNineteen = "Thirteen"
        Case 14: TenNineteen = "Fourteen"
        Case 15: TenNineteen = "Fifteen"
        Case 16: TenNineteen = "Sixteen"
        Case 17: TenNineteen = "Seventeen"
        Case 18: TenNineteen = "Eighteen"
        Case 19: TenNineteen = "Nineteen"
        Case Else: TenNineteen = ""
    End Select
End Function
Private Function TwentyNinety(Num20_90 As Byte) As String
    Select Case Num20_90
        Case 20: TwentyNinety = "Twenty"
        Case 30: TwentyNinety = "Thirty"
        Case 40: TwentyNinety = "Fourty"
        Case 50: TwentyNinety = "Fifty"
        Case 60: TwentyNinety = "Sixty"
        Case 70: TwentyNinety = "Seventy"
        Case 80: TwentyNinety = "Eighty"
        Case 90: TwentyNinety = "Ninety"
        Case Else: TwentyNinety = ""
    End Select
End Function
Private Function TransferHundred(NumSatak As Byte) As String
    Dim TempTH As String
   
    If NumSatak >= 10 And NumSatak <= 19 Then
        TransferHundred = TenNineteen(NumSatak)
    ElseIf NumSatak >= 0 And NumSatak <= 9 Then
        TransferHundred = TransferTen(NumSatak)
    ElseIf NumSatak >= 20 And NumSatak <= 99 Then
        If (NumSatak Mod 10) = 0 Then
            TempTH = TwentyNinety(Left$(NumSatak, 1) * 10)
        Else
            TempTH = TwentyNinety(Left$(NumSatak, 1) * 10) & " " & TransferTen(Right$(NumSatak, 1) * 1)
        End If
        TransferHundred = TempTH
    End If
End Function

Function TransferNumberToText(Num As Currency)
    Dim TempTNTT As String, tempText As String, Temp As Byte
   
    Num = Round(Num, 0)
   
    Select Case Num
        Case Is > 999999999
             TransferNumberToText = "Too Large Value"
            Exit Function
        Case 0
            TransferNumberToText = "Zero"
            Exit Function
        Case Is < 0
            TransferNumberToText = "Be Positive No Negative"
            Exit Function
    End Select
   
    TempTNTT = Num
   
    tempText = " Only"
   
    TempTNTT = Right$("00000000" & TempTNTT, 9)
   
    tempText = TransferHundred(CByte(Mid$(TempTNTT, 8, 2))) & tempText
   
    Temp = CByte(Mid$(TempTNTT, 7, 1))
    If Temp <> 0 Then
        tempText = TransferTen(Temp) & " Hundred " & tempText
    End If
   
    Temp = CByte(Mid$(TempTNTT, 5, 2))
    If Temp <> 0 Then
        tempText = TransferHundred(Temp) & " Thousand " & tempText
    End If
   
    Temp = CByte(Mid$(TempTNTT, 3, 2))
    If Temp <> 0 Then
        tempText = TransferHundred(Temp) & " Lakh " & tempText
    End If
   
    Temp = CByte(Mid$(TempTNTT, 1, 2))
    If Temp <> 0 Then
        tempText = TransferHundred(Temp) & " Crore " & tempText
    End If
   
    If Num = 1 Then
        TransferNumberToText = "Rupee " & tempText
    Else
        TransferNumberToText = "Rupees " & tempText
    End If
   
    TransferNumberToText = Application.WorksheetFunction.Trim(TransferNumberToText)
   
End Function

'********************************************************************************

No comments:

Post a Comment