# Thread: Convert OMR currency numbers to words

1. ## Convert OMR currency numbers to words

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

2. 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

```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

Result = Result & " and " & Cents & " Dollars"```

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

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

I have the code for Dollars as follow:

```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```  Reply With Quote

4. Hey sweety,

The logic is the same for any currency:

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.  Reply With Quote

#### Posting Permissions

• You may not post new threads
• You may not post replies
• You may not post attachments
• You may not edit your posts
•