Spellnumber VBA Code for Qatari Riyal and Dirham

Here in this article, you will get the required VBA code to create a function in Excel to convert the numeric values of Qatari Riyal and Dirham to words format.

Follow these steps to create a SpellQatariRiyal function.

1. Click on Developer tab of Excel.
2. Click on Visual Basics.
3. Click on Insert tab of Visual Basics.
4. Click on Module.
5. Copy the VBA code and Paste in Module. (code is given below)
6. Close the VBA window.
7. Use the SpellQatariRiyal function. For this, click on the cell and type = Spell, this will display the function in the list.
8. Save your file as macro enabled type to store the function permanently.

IF Developer Tab not Enabled

IF your Excel does not have Developer tab, follow the instruction below to enable.

1. Click on File tab of Excel.
2. Click on Options from the side menu.
3. Click on Customize Ribbon.
4. In the main tabs list, mark the Developer tab, then click OK.

Saving Workbook as Macro – Enabled

Since we use macro codes to make a custom function, we have to change the file type of our workbook that can store the macro codes.

Follow these steps to save the workbook as Macro-Enabled.

1. Click of File tab of Excel.
2. Click on Save As.
3. Expand the file type and select “Excel Macro-Enabled Workbook (*.xlsm)“. This is available just below file name box.
4. Choose the location to save the file and click on Ok.

VBA Macro Code

Get the code from below. Select it and Copy.

Function SpellQatariRiyal(ByVal MyNumber) As String
    Dim WholeNumber As String
    Dim DecimalValue As String
    Dim DecimalWord As String
    Dim Temp As String
    Dim DecimalPlace As Integer
    Dim Count As Integer
    Dim DecimalSeparator As String
    Dim UnitName As String
    Dim SubUnitName As String
    Dim DecimalSeparatorIndex As Integer

    ReDim Place(9) As String
    Place(2) = " Thousand "
    Place(3) = " Million "
    Place(4) = " Billion "
    Place(5) = " Trillion "

    ' Convert MyNumber to String, preserving decimal separator
    MyNumber = Trim(CStr(MyNumber))
    DecimalSeparatorIndex = InStr(MyNumber, Application.DecimalSeparator)

    If DecimalSeparatorIndex > 0 Then
        DecimalValue = GetTens(Left(Mid(MyNumber, DecimalSeparatorIndex + 1) & "00", 2))
        DecimalWord = " Rials and " & DecimalValue & " Baisa"
        MyNumber = Trim(Left(MyNumber, DecimalSeparatorIndex - 1))
    End If

    Count = 1
    Do While MyNumber <> ""
        Temp = GetHundreds(Right(MyNumber, 3))
        If Temp <> "" Then WholeNumber = Temp & Place(Count) & WholeNumber
        If Len(MyNumber) > 3 Then
            MyNumber = Left(MyNumber, Len(MyNumber) - 3)
        Else
            MyNumber = ""
        End If
        Count = Count + 1
    Loop

    If DecimalValue = "" Then
        SpellQatariRiyal = WholeNumber & " Qatari Riyal"
    ElseIf DecimalValue = "One" Then
        SpellQatariRiyal = WholeNumber & " Qatari Riyal and " & DecimalValue & " Dirham"
    Else
        SpellQatariRiyal = WholeNumber & " Qatari Riyal and " & DecimalValue & " Dirham"
    End If
End Function

Function GetHundreds(ByVal MyNumber) As String
    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

Function GetTens(TensText) As String
    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

Function GetDigit(Digit) As String
    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