Convert number to text

 2017-04-29    Functions    0    228

The code below can be put into a new code module and then be used to convert a number to text, e.g. 9999 = nine thousand ninehundredandninetynine.
English and Norwegian is supported, other languages can easily be added.

Option Explicit
' updated 2017-04-29 by OPE, http://erlandsendata.no
' this module contains code necessary to convert a numeric value to text
' handles English and Norwegian but can easliy be extended or converted to most languages
' add supported languages by translating or adding text labels in the procedure PopulateStrings

' this module has only one public function: GetNumberAsText(dblNumber, [blnCurrency], [lngLanguage])
' dblNumber: any integer or decimal number supported by the Double data type
' blnCurrence: default = False, can optionally be set to True to include currency information in the returned text
' lngLanguage: default = current system language, can optionally be set to a language code defined in the procedure PopulateStrings

' module level variables
Private strInteger As String, strIntegers As String, strDecimal As String, strDecimals As String
Private strAnd As String, strComma As String, strMinus As String, strAltOne As String
Private varNumbers10 As Variant, varNumbers20 As Variant, varLabel As Variant, varLabels As Variant

Private Sub PopulateStrings(Optional lngLanguage As Long = -1)
' updated 2017-04-28 by OPE
' this procedure can be updated with new text labels for new languages
    If lngLanguage < 1 Then
        lngLanguage = Application.International(xlCountrySetting)
    End If
    ' when adding or changing languages it is recommended to use the same country code numbers returned by Application.International(xlCountrySetting)
    Select Case lngLanguage
        Case 47 ' norwegian
            strInteger = "krone" ' label for integer = 1
            strIntegers = "kroner" ' label for other integers
            strDecimal = "øre" ' label for decimal = 1
            strDecimals = "øre" ' label for other decimals
            strAnd = "og" ' label for AND
            strComma = "komma" ' label for COMMA
            strMinus = "minus" ' label for negative values
            strAltOne = "ett" ' alternative label for 1 used for single hundreds and single thousands only
            varNumbers10 = Array("ti", "tjue", "tretti", "førti", "femti", "seksti", "sytti", "åtti", "nitti", "hundre") ' labels for 10 units
            varNumbers20 = Array("null", "en", "to", "tre", "fire", "fem", "seks", "syv", "åtte", "ni", "ti", "elleve", "tolv", "tretten", "fjorten", "femten", "seksten", "sytten", "atten", "nitten") ' labels for units 1 - 19
            varLabel = Array("tusen", "million", "milliard", "trillion", "kvadrillion", "kvintillion", "sekstillion", "septillion") ' labels for 1 unit
            varLabels = Array("tusen", "millioner", "milliarder", "trillioner", "kvadrillioner", "kvintillioner", "sekstillioner", "septillioner") ' labels for other units
        Case Else ' default language, english
            strInteger = "dollar" ' label for integer = 1
            strIntegers = "dollars" ' label for other integers
            strDecimal = "cent" ' label for decimal = 1
            strDecimals = "cents" ' label for other decimals
            strAnd = "and" ' label for AND
            strComma = "comma" ' label for COMMA
            strMinus = "minus" ' label for negative values
            strAltOne = "one" ' alternative label for 1 used for single hundreds and single thousands only
            varNumbers10 = Array("ten", "twenty", "thirty", "forty", "fifty", "sixty", "seventy", "eighty", "ninety", "hundred") ' labels for 10 units
            varNumbers20 = Array("zero", "one", "two", "three", "four", "five", "six", "seven", "eight", "nine", "ten", "eleven", "twelve", "thirteen", "fourteen", "fifteen", "sixteen", "seventeen", "eighteen", "nineteen") ' labels for units 1 - 19
            varLabel = Array("thousand", "million", "billion", "trillion", "quadrillion", "quintillion", "sextillion", "septillion") ' labels for 1 unit
            varLabels = Array("thousands", "millions", "billions", "trillions", "quadrillions", "quintillions", "sextillions", "septillions") ' labels for other units
    End Select
End Sub

Function GetNumberAsText(dblNumber As Double, Optional blnCurrency As Boolean = False, Optional lngLanguage As Long = -1) As String
' updated 2017-04-28 by OPE
' returns dblNumber as a text, optionally for a different language defined in PopulateStrings
' if blnCurrency is True then the text returned will contain information about currency (e.g. dollars or krone) as defined in PopulateStrings
' if lngLanguage is < 1 then the system country setting will be used to determine the language
' if lngLanguage is >= 1 then the function will try to return text in the language specified if it exists in PopulateStrings
' if the language code is not specified in PopulateStrings then the default language defined in PopulateStrings will be used
Dim blnNegative As Boolean, strNumber As String, strResult As String, dblDecimals As Double, strDecimal As String
Dim lngDigitGroups As Long, varGroup() As Variant, lngCount As Long, i As Long
    Application.Volatile ' remove this line if you don't want this function to calculate all the time when used as a worksheet function
    PopulateStrings lngLanguage
    blnNegative = dblNumber < 0
    
    ' code for the integer part of dblNumber
    lngCount = Len(Format(Fix(Abs(dblNumber)), "0")) ' count of digits in the integer part of dblNumber
    Do While lngCount Mod 3 <> 0
        lngCount = lngCount + 1
    Loop
    lngDigitGroups = lngCount / 3 ' count of digit groups
    ReDim varGroup(1 To lngDigitGroups, 1 To 2) ' digit groups and value
    strNumber = Replace(Space(lngCount), " ", "0") ' create required number format
    strNumber = Format(Fix(Abs(dblNumber)), strNumber) ' apply number format
    For i = 1 To lngDigitGroups
        varGroup(i, 1) = CLng(Mid(strNumber, (i * 3 - 2), 3)) ' remember group digits
        varGroup(i, 2) = varGroup(i, 1) ' remember group value
    Next i
    ' convert each digit group to text
    For i = 1 To lngDigitGroups
        varGroup(i, 1) = Text100(CLng(varGroup(i, 2)), lngDigitGroups - i + 1, lngDigitGroups, lngLanguage)
    Next i
    If Len(varGroup(1, 1)) = 0 Then
        varGroup(1, 1) = varNumbers20(LBound(varNumbers20)) ' add label for zero values
    End If
    ' create output string
    strResult = vbNullString
    For i = 1 To lngDigitGroups
        strResult = Trim(strResult & varGroup(i, 1)) & " "
    Next i
    If blnCurrency Then ' add currency label
        If varGroup(lngDigitGroups, 2) = 1 Then
            strResult = strResult & strInteger ' currency label for 1 unit
        Else
            strResult = strResult & strIntegers ' currency label for other units
        End If
    End If
    strResult = Trim(strResult)
    
    ' code for the decimal part of dblNumber
    dblDecimals = Abs(dblNumber - Fix(dblNumber))
    If dblDecimals > 0 Then ' has decimals
        strNumber = "0." & Replace(Space(Len(dblDecimals) - 2), " ", "0") ' create required number format
        strNumber = Format(dblDecimals, strNumber) ' apply number format
        strNumber = Mid(strNumber, 3) ' skip stuff before decimal
        strNumber = RTrimChar(strNumber, "0")
        Select Case Len(strNumber)
            Case 1
                strDecimal = NumberItemsToText(strNumber, " ", lngLanguage)
            Case 2
                If CLng(strNumber) < 10 Then
                    strDecimal = NumberItemsToText(strNumber, " ", lngLanguage)
                Else
                    strDecimal = Text100(CLng(strNumber), 1, 1, lngLanguage)
                End If
            Case Else
                strDecimal = NumberItemsToText(strNumber, " ", lngLanguage)
        End Select
        
        If blnCurrency Then
            strResult = strResult & " " & strAnd & " " ' add "AND" to the label
        Else
            strResult = strResult & " " & strComma & " " ' add "COMMA" to the label
        End If
        strResult = strResult & strDecimal
        
        If blnCurrency Then
            If Len(strNumber) = 2 And CLng(strNumber) = 1 Then
                strResult = strResult & " " & strDecimal ' add currency label for decimal part
            Else
                strResult = strResult & " " & strDecimals ' add currency label for decimal part
            End If
        End If
    End If
    If blnNegative Then
        strResult = strMinus & " " & strResult ' add negative label if required
    End If
    GetNumberAsText = Trim(strResult)
End Function

Private Function Text100(lngNumber As Long, lngDigitGroup As Long, lngDigitGroupsCount As Long, Optional lngLanguage As Long = -1) As String
' updated 2017-04-28 by OPE
' returns the text label for lngNumber >=1 and <=999
' lngDigitGroup: the digit group for which lngNumber belongs.
' lngDigitGroupsCount: count of digit groups in the original number.
Dim strResult As String, lngHundred As Long, lngUpToHundred As Long, lngPart As Long, lngOffset As Long
    If lngNumber < 1 Or lngNumber >= 1000 Then Exit Function
    If Not IsArray(varLabel) Then
        PopulateStrings lngLanguage
    End If
    
    lngHundred = CLng(Left((Format(Abs(lngNumber), "000")), 1)) ' count of hundreds in lngNumber
    lngUpToHundred = CLng(Right((Format(Abs(lngNumber), "000")), 2)) ' value less than 100 in lngNumber
    strResult = vbNullString
    Select Case lngUpToHundred
        Case 1 To 19
            strResult = Text20(lngUpToHundred, lngDigitGroup = 2, lngLanguage) ' get text label
        Case 20 To 99
            lngPart = lngUpToHundred Mod 10 ' value less than 10 in lngNumber
            strResult = Text10(CLng(Left((Format(lngUpToHundred, "00")), 1)), lngLanguage) & Text20(lngPart, lngDigitGroup = 2 And lngUpToHundred = 1, lngLanguage) ' get text label
    End Select
    If lngHundred > 0 Then
        If lngUpToHundred > 0 Then
            strResult = strAnd & strResult ' add "AND" to the label
        End If
        strResult = Text20(lngHundred, True, lngLanguage) & varNumbers10(UBound(varNumbers10)) & strResult ' add "HUNDRED" to the label
    Else
        If lngDigitGroup < lngDigitGroupsCount Then
            strResult = strAnd & " " & strResult ' add "AND " to the label
        End If
    End If
    
    lngOffset = 1 - LBound(varLabel)
    lngPart = lngDigitGroup - 1 ' calculate index number for digit group label
    If lngPart > 0 And lngPart <= UBound(varLabel) Then
        If lngNumber = 1 Then
            strResult = strResult & " " & Trim(varLabel(lngPart - lngOffset)) ' add digit group label
        Else
            strResult = strResult & " " & Trim(varLabels(lngPart - lngOffset)) ' add digit group label
        End If
    End If
    strResult = Replace(strResult, "ttt", "tt") ' remove triple t's (norwegian spelling exception)
    Text100 = strResult ' apply function result
End Function

Private Function Text20(lngNumber As Long, Optional blnAltOne As Boolean = False, Optional lngLanguage As Long = -1) As String
' updated 2017-04-28 by OPE
' returns the text label for lngNumber >=0 and <=19
Dim strResult As String, lngOffset As Long
    If Not IsArray(varNumbers10) Then
        PopulateStrings lngLanguage
    End If
    If lngNumber >= 1 And lngNumber <= 19 Then
        If lngNumber = 1 And blnAltOne Then
            strResult = strAltOne
        Else
            lngOffset = 1 - LBound(varNumbers20)
            strResult = varNumbers20(lngNumber + 1 - lngOffset) ' first array item is zero, last is nineteen
        End If
        Text20 = Trim(strResult)
    End If
End Function

Private Function Text10(lngNumber As Long, Optional lngLanguage As Long = -1) As String
' updated 2017-04-28 by OPE
' returns the text label for lngNumber * 10
Dim lngOffset As Long
    If Not IsArray(varNumbers10) Then
        PopulateStrings lngLanguage
    End If
    If lngNumber >= 1 And lngNumber <= 10 Then
        lngOffset = 1 - LBound(varNumbers10)
        Text10 = Trim(varNumbers10(lngNumber - lngOffset)) ' first array item is ten, last is hundred
    End If
End Function

Private Function NumberItemsToText(varNumber As Variant, Optional strDelimiter As String = " ", Optional lngLanguage As Long = -1) As String
' updated 2017-04-28 by OPE
' returns a text with the individual numbers in varNumber
Dim strResult As String, strText As String, blnMinus As Boolean, i As Long, j As Long, lngOffset As Long
    If Not IsArray(varNumbers20) Then
        PopulateStrings lngLanguage
    End If
    If TypeName(varNumber) = "String" Then
        blnMinus = Left(Trim(varNumber), 1) = "-"
        If blnMinus Then
            strText = Mid(Trim(varNumber), 2)
        Else
            strText = Trim(varNumber)
        End If
    Else
        blnMinus = varNumber < 0
        strText = Format(Abs(varNumber), "0")
    End If
    
    lngOffset = 1 - LBound(varNumbers20)
    For i = 1 To Len(strText)
        j = CLng(Mid(strText, i, 1))
        strResult = strResult & varNumbers20(j + 1 - lngOffset) & strDelimiter ' first array item is zero
    Next i
    If Len(strResult) > 0 And Len(strDelimiter) > 0 Then
        strResult = Left(strResult, Len(strResult) - Len(strDelimiter))
    End If
    If blnMinus Then
        strResult = strMinus & " " & strResult
    End If
    NumberItemsToText = strResult
End Function

Private Function RTrimChar(strText As String, strChar As String) As String
' updated 2017-04-28 by OPE
Dim strResult As String
    If Len(strText) = 0 Then Exit Function
    If Len(strChar) = 0 Then Exit Function
    
    strResult = strText
    Do While Right(strResult, Len(strChar)) = strChar
        strResult = Left(strResult, Len(strResult) - Len(strChar))
    Loop
    RTrimChar = strResult
End Function
You can use the code above like this in a worksheet:
=GetNumberAsText(A1)
=GetNumberAsText(A1;True)
=GetNumberAsText(A1;True;47)


You can use the code above like this in your code:
strText = GetNumberAsText(Range("A1").Value)
strText = GetNumberAsText(Range("A1").Value, True)
strText = GetNumberAsText(Range("A1").Value, True, 47)


Click here to download this file.
Updated: 2017-04-29 Requires: XL2007 File size: 35 kB


This is an updated code example from 2006-05-06