NUMBERTOWORDS

Returns the word equivalent for a numerical number.


dbMyNumberThe number you want to convert to text.
sMainUnitPluralThe unit to use for whole numbers.
sMainUnitSingleThe unit to use for single whole numbers.
sDecimalUnitPlural(Optional) The unit to use for decimal values.
sDecimalUnitSingle(Optional) The unit to use for single decimal values.


REMARKS
This function returns the same value for positive and negative numbers.
All numbers will be rounded to the nearest 2 decimal places.
This function will only return the correct text for numbers less than 999,999,999,999,999 (nine hundred trillion).
Thanks to Bernd Plumhoff for correcting this function.


Option Explicit 

Public Function SPELLNUMBER(ByVal dbMyNumber As Double, _
                            ByVal sMainUnitPlural As String, _
                            ByVal sMainUnitSingle As String, _
                   Optional ByVal sDecimalUnitPlural As String = "", _
                   Optional ByVal sDecimalUnitSingle As String = "")

   Dim sMyNumber As String
   Dim sCurrency As String
   Dim sDecimalText As String
   Dim sTemp As String
   Dim iDecimalPlace As Integer
   Dim iCount As Integer

   ReDim Place(9) As String
   Application.Volatile (True)
   Place(2) = "Thousand"
   Place(3) = "Million"
   Place(4) = "Billion"
   Place(5) = "Trillion"
   sMyNumber = Trim(CStr(dbMyNumber))
   iDecimalPlace = InStr(dbMyNumber, ".")

   If iDecimalPlace > 0 Then
      sDecimalText = GetTens(Left(Mid(Round(sMyNumber, 2), iDecimalPlace + 1) & "00", 2))
      If Len(sDecimalText) > 0 Then
         sMyNumber = Trim(Left(sMyNumber, iDecimalPlace - 1))
      Else
         sMyNumber = ""
      End If
   End If
   iCount = 1
   Do While sMyNumber <> ""
       sTemp = GetHundreds(sMyNumber, Right(sMyNumber, 3), iDecimalPlace)
       If sTemp <> "" Then
          If (iCount > 1) And (LCase(Left(Trim(sCurrency), 3)) <> "and") Then
             sCurrency = ", " & sCurrency
          End If
          sCurrency = sTemp & Place(iCount) & sCurrency
       End If
       If Len(sMyNumber) > 3 Then
           sMyNumber = Left(sMyNumber, Len(sMyNumber) - 3)
       Else
           sMyNumber = ""
       End If
       iCount = iCount + 1
   Loop
   Select Case Trim(sCurrency)
       Case "": sCurrency = "No " & sMainUnitPlural
       Case "One": sCurrency = "One " & sMainUnitSingle
       Case Else: sCurrency = sCurrency & sMainUnitPlural
   End Select
   If iDecimalPlace > 0 Then
       If (Len(sDecimalUnitPlural) > 0 And Len(sDecimalUnitSingle) > 0) Then
          sCurrency = sCurrency & ", "
           Select Case Trim(sDecimalText)
               Case "": sDecimalText = "No " & sDecimalUnitPlural
               Case "One": sDecimalText = "One " & sDecimalUnitSingle
               Case Else: sDecimalText = sDecimalText & sDecimalUnitPlural
           End Select
       Else
       sCurrency = sCurrency & " and "
       sDecimalText = Mid(Trim(Str(dbMyNumber)), iDecimalPlace + 1) & "/100"
       End If
   End If
   SPELLNUMBER = Trim(sCurrency & sDecimalText)
End Function


Function GetHundreds(ByVal sMyNumber As String, _ 
                     ByVal sHundredNumber As String, _
                     ByVal iDecimal As Integer) As String

    Dim sResult As String
    
    If sHundredNumber = "0" Then Exit Function
    sHundredNumber = Right("000" & sHundredNumber, 3)
    If Mid(sHundredNumber, 1, 1) <> "0" Then
        sResult = GetDigit(Mid(sHundredNumber, 1, 1)) & "Hundred"
    End If
    If (sMyNumber > 1000) And (Mid(sHundredNumber, 3, 1) <> "0" Or _
                               Mid(sHundredNumber, 2, 1) <> "0") Or _
       (Len(sResult) > 0) And (Mid(sHundredNumber, 3, 1) <> "0" Or _
                               Mid(sHundredNumber, 2, 1) <> "0") Then
       sResult = sResult & " and "
    End If
    If Mid(sHundredNumber, 2, 1) <> "0" Then
       sResult = sResult & GetTens(Mid(sHundredNumber, 2))
    Else
       If Mid(sHundredNumber, 3, 1) <> "0" Then
          sResult = sResult & GetDigit(Mid(sHundredNumber, 3))
       Else
          sResult = sResult & " "
       End If
    End If
    GetHundreds = sResult
End Function


Function GetTens(ByVal sTensText As String) As String 

    Dim sResult As String

    sResult = ""
    If Left(sTensText, 1) = 1 Then
        Select Case sTensText
            Case "10": sResult = "Ten "
            Case "11": sResult = "Eleven "
            Case "12": sResult = "Twelve "
            Case "13": sResult = "Thirteen "
            Case "14": sResult = "Fourteen "
            Case "15": sResult = "Fifteen "
            Case "16": sResult = "Sixteen "
            Case "17": sResult = "Seventeen"
            Case "18": sResult = "Eighteen "
            Case "19": sResult = "Nineteen "
            Case Else
        End Select
    Else
        Select Case Left(sTensText, 1)
            Case "2": sResult = "Twenty "
            Case "3": sResult = "Thirty "
            Case "4": sResult = "Forty "
            Case "5": sResult = "Fifty "
            Case "6": sResult = "Sixty "
            Case "7": sResult = "Seventy "
            Case "8": sResult = "Eighty "
            Case "9": sResult = "Ninety "
            Case Else
        End Select
        sResult = sResult & GetDigit(Right(sTensText, 1))
    End If
    GetTens = sResult
End Function


Function GetDigit(ByVal sDigit As String) As String 
    Select Case sDigit
        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


Example


 

© 2017 Better Solutions Limited. All Rights Reserved. © 2017 Better Solutions Limited

Top

PrevNext