RsInWords

https://www.youtube.com/watch?v=Y62quktKrI0

1. Open the Excel workbook in which you want to create the VBA module.

2. Press Alt F11 Or Click on the Developer tab on the ribbon. If the Developer tab is not visible, go to File > Options > Customize Ribbon and check the Developer box.

3. Click on the Visual Basic button in the Code group on the Developer tab. This will open the Visual Basic Editor (VBE).

4. In the VBE, click on the Insert menu and select Module. This will create a new module in the workbook.

5. In the module, you can past copy code.

6. In cell A1, enter the numerical value of the amount you want to convert to words. In cell B1, enter the following formula: =RsInWords(A1) Press Enter to apply the formula to cell B1. The cell B1 will now display the amount in words, in Indian rupees.

Example Code Provided by "BigGuideForYou"

Function RsInWords(ByVal MyNumber)
     
   '****************' Main Function *'****************
     
    Dim Rupees, paise, Temp
    Dim DecimalPlace, Count
    ReDim Place(9) As String
    Place(2) = " thousand "
    Place(3) = " lac "
    Place(4) = " crore "
    Place(5) = " arab " ' String representation of amount
    MyNumber = Trim(str(MyNumber)) ' Position of decimal place 0 if none
    DecimalPlace = InStr(MyNumber, ".")
     ' Convert Paise and set MyNumber to Rupee amount
    If DecimalPlace > 0 Then
        paise = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & "00", 2))
        MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
    End If
    Count = 1
    Do While MyNumber <> ""
        If Count = 1 Then Temp = GetHundreds(Right(MyNumber, 3))
        If Count > 1 Then Temp = GetHundreds(Right(MyNumber, 2))
        If Temp <> "" Then Rupees = Temp & Place(Count) & Rupees
        If Count = 1 And Len(MyNumber) > 3 Then
            MyNumber = Left(MyNumber, Len(MyNumber) - 3)
        Else
            If Count > 1 And Len(MyNumber) > 2 Then
                MyNumber = Left(MyNumber, Len(MyNumber) - 2)
            Else
                MyNumber = ""
            End If
        End If
        Count = Count + 1
     Loop
    Select Case Rupees
    Case ""
        Rupees = "Rupees nil"
    Case "one"
        Rupees = "Rupee one"
    Case Else
         '****************************************************************
         'Yogi Anand on 20-Sep-2003
         'modified the following two lines to display "Rupees" to precede
         ' rem'd the first line and added the second line
         '****************************************************************
         'Rupees = Rupees & " Rupees"
        Rupees = "Rupees " & Rupees
         
    End Select
    Select Case paise
    Case ""
         '****************************************************************
         'Yogi Anand on 20-Sep-2003
         'modified the following two lines to display nothing for no paise
         ' rem'd the first line and added the second line
         '****************************************************************
         
         'Paise = " and No Paise"
         '****************************************************************
         'Yogi Anand on 03-Oct-2003
         'modified the following line to display " Only" for no paise
         ' rem'd the first line and added the second line
         '****************************************************************
         'Paise = ""
        paise = " only"
    Case "one"
        paise = " and one paisa only"
    Case Else
        paise = " and " & paise & " paise only"
         
    End Select
    RsInWords = Rupees & paise
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
    

-

To create a VBA macro in Excel that performs the following actions:

1. Open a new workbook in Excel.
2. Press "Alt + F11" to open the Visual Basic Editor.
3. In the editor, go to "File" > "New" > "Project".
4. In the "New Project" dialog box, select "Excel Add-In" as the project type and give the add-in a name.
5. Click "Create".
6. In the "Project - [add-in name]" window, go to "Module1".
7. In the code window, paste the VBA code for the macro you want to use in every workbook.
8. Save the add-in by going to "File" > "Save [add-in name]".
9. In the "Save As" dialog box, select "Excel Add-In" as the file type and save the file in a location where you can find it (e.g. your desktop).
10. Close the Visual Basic Editor and the add-in workbook.
11. In Excel, go to "File" > "Options" > "Add-Ins".
12. In the "Manage" drop-down list, select "Excel Add-ins" and click "Go".
13. In the "Add-Ins" dialog box, click "Browse".
14. In the "Add-Ins" dialog box, select the add-in file you saved in step 9 and click "OK".
15. The add-in will be added to the list of available add-ins. Check the box next to the add-in name to activate it.
16. Click "OK" to close the "Add-Ins" dialog box.
17. The macro is now available in every workbook you open. You can use the "Ctrl + R" shortcut key to trigger the macro and select a cell reference to insert the formula "=RsInWords(cell_reference)" in the selected cell.

Example Code Provided by "BigGuideForYou"

Sub InsertRsinwordFormula()
    Dim cellRange As Range
    
    'Prompt user to select cell range
    On Error Resume Next 'Prevent errors if Cancel is clicked
    Set cellRange = Application.InputBox("Select cell range", "Cell Range", Type:=8)
    On Error GoTo 0
    
    'Insert formula in selected cell if cell range is valid
    If cellRange Is Nothing Then Exit Sub
    If cellRange.Cells.Count > 1 Then Exit Sub
    
    ActiveCell.Formula = "=RsInWords(" & cellRange.Address(False, False) & ")"
End Sub

'Assign macro to "Ctrl + R" shortcut key
Sub Auto_Open()
    Application.OnKey "^r", "InsertRsinwordFormula"
End Sub

'Clear macro assignment when workbook closes
Sub Auto_Close()
    Application.OnKey "^r"
End Sub