Numeric to Alphabets

kamranyd

Board Regular
Joined
Apr 24, 2018
Messages
115
Office Version
  1. 2019
Platform
  1. Windows
Hi, these codes convert numeric into alphabets, like 1 into One with currency name like "OMR One" & "OMR Zero" but when I type 2 or any other digit it converts into "Two OMR or Three OMR" and so on . I want "OMR" always come before alphabets.

VBA Code:
Option Explicit
'Main Function
Function SpellNumber(ByVal MyNumber)
    Dim Rials, Baiza, Temp
    Dim DecimalPlace, Count
    ReDim Place(9) As String
    Place(2) = " Thousand "
    Place(3) = " Million "
    Place(4) = " Billion "
    Place(5) = " Trillion "
    ' String representation of amount.
    MyNumber = Trim(Str(MyNumber))
    ' Position of decimal place 0 if none.
    DecimalPlace = InStr(MyNumber, ".")
    ' Convert Baiza and set MyNumber to rial amount.
    If DecimalPlace > 0 Then
        Baiza = GetHundreds(Left(Mid(MyNumber, DecimalPlace + 1) & _
                  "000", 3))
        MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
    End If
    Count = 1
    Do While MyNumber <> ""
        Temp = GetHundreds(Right(MyNumber, 3))
        If Temp <> "" Then Rials = Temp & Place(Count) & Rials
        If Len(MyNumber) > 3 Then
            MyNumber = Left(MyNumber, Len(MyNumber) - 3)
        Else
            MyNumber = ""
        End If
        Count = Count + 1
    Loop
    Select Case Rials
         Case ""
             Rials = "OMR Zero"
         Case "One"
             Rials = "OMR One"
         Case Else
             Rials = Rials & " OMR"
    End Select
    Select Case Baiza
        Case ""
            Baiza = ""
        Case "One"
            Baiza = " and One Baiza"
              Case Else
            Baiza = " and " & Baiza & " Baiza Only"
    End Select
    SpellNumber = Rials & Baiza
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
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

smozgur

BatCoder
Joined
Feb 28, 2002
Messages
1,850
In your code, find the following:
VBA Code:
Rials = Rials & " OMR"
Change with the following:
VBA Code:
Rials = "OMR " & Rials
 

kamranyd

Board Regular
Joined
Apr 24, 2018
Messages
115
Office Version
  1. 2019
Platform
  1. Windows
In your code, find the following:
VBA Code:
Rials = Rials & " OMR"
Change with the following:
VBA Code:
Rials = "OMR " & Rials
thanx, how about when there is value 1 it show OMR One, OMR Two and so on, if the value is 1.100 or any it show "OMR One and One Hundred Baiza Only", how to make these codes that it show "OMR One Only" or "OMR Two Only" and so on and when "Baiza Only" comes at the end then it should not show "OMR One Only" instead "OMR One and One Hundred Baiza Only" I mean to say when values one or any value single then it should show "Only" at the end.
 

smozgur

BatCoder
Joined
Feb 28, 2002
Messages
1,850
thanx, how about when there is value 1 it show OMR One, OMR Two and so on, if the value is 1.100 or any it show "OMR One and One Hundred Baiza Only", how to make these codes that it show "OMR One Only" or "OMR Two Only" and so on and when "Baiza Only" comes at the end then it should not show "OMR One Only" instead "OMR One and One Hundred Baiza Only" I mean to say when values one or any value single then it should show "Only" at the end.
This is a separate question. Please post a new question with this new description, so helpers would be notified about the question and you'll likely get a faster solution.
 

Forum statistics

Threads
1,176,286
Messages
5,902,327
Members
434,962
Latest member
sgilmoreBBP

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top