Convert OMR currency numbers to words

How can the numbers of Omani Riyal currency be shown or converted to words (letters) automatically.

Parse the value from least to largest, lookup the terminology; add terminology to indicate magnitudes. Pay attention to special cases,

English Dollar example: $123,456,789.10

Code:

---

Magnitudes = Array("Hundred","Thousand","Million","Billion","Trillion")

Cents = Split(Value, ".")(1)
Dollars = Value - "." & Cents
Groups = Split(Value, ",")
  'If you don't use separators, you will have to separate by counting digits

  'Reverse the Groups
For i = Ubound(Groups) To LBound(Groups) Step -1
  GroupsRev = GroupsRev & Groups(i) & ","
Next i
GroupsRev = Split(GroupsRev, ",")
  'GroupsRev is in Smallest to Largest order. Empty Group at end?

  'Parse each GroupRev to Words
For i = Lbound(GroupRev To Uboulnd(GroupRev)
 'Blah, Blah, Blah
Result = ParsedGroup & WorksheetFunction.Index(Magnitudes, i + 1) & Result
Next i
  'Result is now again in Largest to smallest order

  'Add Cents
Result = Result & " and " & Cents & " Dollars"

---

Hope this Helps. Sorry I couldn't do more, I don't have Office installed on this new computer.

Thank you dear,
but I need the codes for OMR currency.

I have the code for Dollars as follow:

Code:

---

Function NumberstoWords(ByVal pNumber)
    Dim Dollars, Cents
    arr = Array("", "", " Thousand ", " Million ", " Billion ", " Trillion ")
    pNumber = Trim(Str(pNumber))
    xDecimal = InStr(pNumber, ".")
    If xDecimal > 0 Then
        Cents = GetTens(Left(Mid(pNumber, xDecimal + 1) & "00", 2))
        pNumber = Trim(Left(pNumber, xDecimal - 1))
    End If
    xIndex = 1
    Do While pNumber <> ""
        xHundred = ""
        xValue = Right(pNumber, 3)
        If Val(xValue) <> 0 Then
            xValue = Right("000" & xValue, 3)
            If Mid(xValue, 1, 1) <> "0" Then
                xHundred = GetDigit(Mid(xValue, 1, 1)) & " Hundred "
            End If
            If Mid(xValue, 2, 1) <> "0" Then
                xHundred = xHundred & GetTens(Mid(xValue, 2))
            Else
                xHundred = xHundred & GetDigit(Mid(xValue, 3))
            End If
        End If
        If xHundred <> "" Then
            Dollars = xHundred & arr(xIndex) & Dollars
        End If
        If Len(pNumber) > 3 Then
            pNumber = Left(pNumber, Len(pNumber) - 3)
        Else
            pNumber = ""
        End If
        xIndex = xIndex + 1
    Loop
    Select Case Dollars
        Case ""
            Dollars = "No Dollars"
        Case "One"
            Dollars = "One Dollar"
        Case Else
            Dollars = Dollars & " Dollars"
    End Select
    Select Case Cents
        Case ""
            Cents = " and No Cents"
        Case "One"
            Cents = " and One Cent"
        Case Else
            Cents = " and " & Cents & " Cents"
    End Select
    NumberstoWords = Dollars & Cents
End Function

Function GetTens(pTens)
    Dim Result As String
    Result = ""
    If Val(Left(pTens, 1)) = 1 Then
        Select Case Val(pTens)
            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
        Select Case Val(Left(pTens, 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(pTens, 1))
    End If
    GetTens = Result
End Function

Function GetDigit(pDigit)
    Select Case Val(pDigit)
        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

---

Hey sweety,

The logic is the same for any currency:

Quote:

---

Parse the value from least to largest, lookup the terminology; add terminology to indicate magnitudes. Pay attention to special cases.

---

If you come up with the base code, I will help you correct and perfect it. I will not spend time to learn the ins and outs of OMR nor the Omani language. (Time = Money. I am busy.)

I will leave this thread here so that anyone who desires can give you a Bespoke solution.

Maybe try this?

Code:

---

Function ConvertOMRToWords(ByVal OMR As Double) As String
    ' Converts Omani Rial (OMR) currency numbers to words.
    ' Handles up to 999,999.999 OMR.
    Dim RialPart As Long
    Dim BaisaPart As Long
    Dim Words As String
    ' Separate Rial and Baisa parts
    RialPart = Int(OMR)
    BaisaPart = Round((OMR - RialPart) * 1000, 0)
    ' Round to 3 decimal places for Baisa
    ' Convert Rial part
    If RialPart > 0 Then
        Words = ConvertNumberToWords(RialPart) & " Omani Rial"
    End If
    ' Convert Baisa part
    If BaisaPart > 0 Then
        If RialPart > 0 Then
            Words = Words & " and "
        End If
        Words = Words & ConvertNumberToWords(BaisaPart) & " Baisa"
    End If
    ' Handle zero case
    If IsEmpty(Words) Then
        Words = "Zero Omani Rial"
    End If
    ConvertOMRToWords = Words
End Function

Function ConvertNumberToWords(ByVal Number As Long) As String
    ' Converts a number to words (helper function).
    Dim Ones(19) As String
    Dim Tens(9) As String
    Dim Hundreds As String
    Dim Thousands As String
    Dim Millions As String
    Dim Billions As String
    Dim Words As String
    On Error GoTo ErrorHandler
    Ones(0) = ""
    Ones(1) = "One"
    Ones(2) = "Two"
    Ones(3) = "Three"
    Ones(4) = "Four"
    Ones(5) = "Five"
    Ones(6) = "Six"
    Ones(7) = "Seven"
    Ones(8) = "Eight"
    Ones(9) = "Nine"
    Ones(10) = "Ten"
    Ones(11) = "Eleven"
    Ones(12) = "Twelve"
    Ones(13) = "Thirteen"
    Ones(14) = "Fourteen"
    Ones(15) = "Fifteen"
    Ones(16) = "Sixteen"
    Ones(17) = "Seventeen"
    Ones(18) = "Eighteen"
    Ones(19) = "Nineteen"
    Tens(2) = "Twenty"
    Tens(3) = "Thirty"
    Tens(4) = "Forty"
    Tens(5) = "Fifty"
    Tens(6) = "Sixty"
    Tens(7) = "Seventy"
    Tens(8) = "Eighty"
    Tens(9) = "Ninety"
    If Number = 0 Then
        ConvertNumberToWords = ""
        ' Handle zero case within this function.
        Exit Function
    End If
    If Number >= 1000000000 Then
        Billions = ConvertNumberToWords(Number \ 1000000000) & " Billion "
        Number = Number Mod 1000000000
    End If
    If Number >= 1000000 Then
        Millions = ConvertNumberToWords(Number \ 1000000) & " Million "
        Number = Number Mod 1000000
    End If
    If Number >= 1000 Then
        Thousands = ConvertNumberToWords(Number \ 1000) & " Thousand "
        Number = Number Mod 1000
    End If
    If Number >= 100 Then
        Hundreds = Ones(Number \ 100) & " Hundred "
        Number = Number Mod 100
    End If
    If Number >= 20 Then
        Words = Tens(Number \ 10)
        Number = Number Mod 10
    End if   
    If Number > 0 Then
        Words = Words & " " & Ones(Number)
    End If
    If Number > 0 Then
        Words = Ones(Number)
    End If
    ConvertNumberToWords = Billions & Millions & Thousands & Hundreds & Words
    Exit Function
    ErrorHandler:  ConvertNumberToWords = "Error"
End Function

---