SPELLNUMBER

Returns the word equivalent for a numerical number.
Thanks to Bernd Plumhoff for correcting this function.
You can use the SPELLNUMBERREVERSE function to go in the opposite direction.

dbMyNumber - The number you want to convert to text. 
sMainUnitPlural - The unit to use for whole numbers.
sMainUnitSingle - The 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.

Public Function NUMBERTOWORDS(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
   NUMBERTOWORDS = 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

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


 

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