Thread: Conversion from figure to words

You will need VBA, a User Defined Function. There's several available, here' my version.

Option Explicit
Option Base 1    ' the functions will not work properly if this is omitted
Option Compare Text

Function NumToText(Number As Double, Optional ShowCurrency As Boolean, Optional CurrencyString As String) As String
    Dim Ipart As Double, Dpart As Long, NegValue As Boolean, sNumber As String
    Dim cdGroups As Integer, dGroups() As String, dgValue() As Integer, nLen As Integer, i As Integer
    Dim Part As String

    If CurrencyString = "pound" Then
        Part = "pence"
    Else: Part = "cents"
    End If

    Application.Volatile
    NumToText = "Zero "    '*** add description for zero values

    If Abs(Number) < 0.001 Then
        If ShowCurrency Then NumToText = NumToText & CurrencyString & "s"    '*** add currency description
        Exit Function
    End If

    If Number < 0 Then NegValue = True Else NegValue = False
    Ipart = Fix(Abs(Number))    ' Integer part of Number
    Dpart = (Abs(Number) - Ipart) * 100    ' Decimal part of Number
    Ipart = Abs(Ipart)    ' remove minus sign

    ' code for the integer part of Number
    nLen = Len(Format(Ipart, "0"))    ' number of digits in Ipart

    While nLen Mod 3 <> 0
        nLen = nLen + 1
    Wend

    cdGroups = nLen / 3    ' number of digit groups

    ReDim dGroups(cdGroups)    ' declare variable
    ReDim dgValue(cdGroups)    ' declare variable

    sNumber = ""

    For i = 1 To nLen
        sNumber = sNumber & "0"    ' create required number format
    Next i

    sNumber = Format(Ipart, sNumber)    ' apply number format

    For i = 1 To cdGroups
        dGroups(i) = Mid(sNumber, (i * 3 - 2), 3)    ' remember group digits
        dgValue(i) = CInt(dGroups(i))    ' remember group value
    Next i

    ' convert each digit group to text
    For i = 1 To cdGroups
        dGroups(i) = Text100(CLng(dGroups(i)), cdGroups - i + 1, cdGroups)
    Next i

    ' create output string
    NumToText = ""

    For i = 1 To cdGroups
        NumToText = NumToText & dGroups(i)
    Next i

    If ShowCurrency Then    ' add currency description
        If dgValue(cdGroups) = 1 Then
            NumToText = NumToText & CurrencyString    '*** currency description for 1 unit
        Else
            NumToText = NumToText & CurrencyString & "s"    '*** currency description for other units
        End If
    End If

    ' code for the decimal part of Number
    If Dpart > 0 Then
        NumToText = Trim(NumToText)
        If ShowCurrency Then
            NumToText = NumToText & " and "    '*** add "AND" or "COMMA" to the description
        Else
            NumToText = NumToText & " point "    '*** add "COMMA" or "AND" to the description
        End If

        NumToText = NumToText & Text100(CLng(Dpart), 1, 1)    '*** convert numbers to text
        If ShowCurrency Then NumToText = NumToText & Part    '*** add currency description for decimal part
    End If

    Erase dGroups    ' clear array variable
    Erase dgValue    ' clear array variable

    If NegValue Then NumToText = "minus " & NumToText    '*** add negative label if required

    'If the value is less than 1 then remove the "dollars and " string from the text.
    If Left(NumToText, 12) = "dollars and " Then NumToText = Right(NumToText, Len(NumToText) - 12)    '*** adjust text appropriately
    If Left(NumToText, 15) = "minus dollars and " Then NumToText = "minus " & Right(NumToText, Len(NumToText) - 18)    '*** adjust text appropriately
    If Left(NumToText, 9) = "GBPs and " Then NumToText = Right(NumToText, Len(NumToText) - 9)    '*** adjust text appropriately
    If Left(NumToText, 15) = "minus dollars and " Then NumToText = "minus " & Right(NumToText, Len(NumToText) - 15)    '*** adjust text appropriately
    If Left(NumToText, 10) = "Euros and " Then NumToText = Right(NumToText, Len(NumToText) - 10)    '*** adjust text appropriately
    If Left(NumToText, 16) = "minus dollars and " Then NumToText = "minus " & Right(NumToText, Len(NumToText) - 16)    '*** adjust text appropriately

End Function

Function Text100(Number As Long, dGroup As Integer, cGroups As Integer) As String
' returns the text description for Number
' Number : must be a value >0 and <1000
' dGroup : the digit group for which Number belongs.
' cGroups : count of digit groups in the original number.

    Dim hPart As Integer, tPart As Integer, oPart As Integer, tText As String
    Dim NumberNames1 As Variant, NumberNames2 As Variant

    Text100 = ""

    If Number >= 1000 Or Number < 1 Then Exit Function

    hPart = CInt(Left((Format(Abs(Number), "000")), 1))    ' count of hundreds in Number
    tPart = CInt(Right((Format(Abs(Number), "000")), 2))    ' value less than 100 in Number
    tText = ""

    If tPart > 0 And tPart <= 19 Then
        If Number = 1 Then
            Select Case cGroups
            Case 1: tText = Text20(tPart, 1)    ' get textdescription for <1 000
            Case 2: tText = Text20(tPart, 1)    ' get textdescription for <1 000 000
            Case Else: tText = Text20(tPart, 1)    ' get textdescription for other values
            End Select
        Else
            tText = Text20(tPart, 1)    ' get text description
        End If
    End If

    If tPart > 19 Then
        oPart = tPart Mod 10    ' value less than 10 in Number
        tText = Text10(CInt(Left((Format(tPart, "00")), 1))) & Text20(oPart, 1)    ' get text description
    End If

    If hPart > 0 And tPart > 0 Then tText = "and " & tText    '*** add "AND" to the description
    If hPart = 0 And dGroup < cGroups Then tText = "and " & tText    '*** add "AND" to the description

    If hPart > 0 Then
        tText = Text20(hPart, 1) & "hundred " & tText    '*** add "HUNDRED" to the description
    End If

    '*** add number description for thousands, millions, billions, trillions, quadrillions, quintillions, sextillions and septillions in the next two array variables
    NumberNames1 = Array("thousand ", "million ", "billion ", "trillion ", "quadrillion ", "quintillion ", "sextillion ", "septillion ")    '*** description for 1 unit
    NumberNames2 = Array("thousand ", "million ", "billion ", "trillion ", "quadrillion ", "quintillion ", "sextillion ", "septillions ")    '*** description for more than 1 unit

    oPart = dGroup - 1    ' calculate index number for digit group description

    If oPart > 0 And oPart <= UBound(NumberNames1) Then
        If Number = 1 Then
            tText = tText & NumberNames1(oPart)    ' add digit group description
        Else
            tText = tText & NumberNames2(oPart)    ' add digit group description
        End If
    End If

    Text100 = tText    ' apply function result
    Erase NumberNames1    ' clear array variable
    Erase NumberNames2    ' clear array variable

End Function

Function Text20(Number As Integer, Optional nAlt As Variant) As String
' returns the text description for Number
' Number : must be a value >0 and <20
' nAlt : alternative text description for the value 1 in different positions.
' *** all 19 string descriptions in this function can be changed for internationalisation purposes
    Dim t As String
    t = ""

    Select Case Number
    Case 1:
        If nAlt = 2 Then
            t = "and "    '*** description for first position in digit group
        Else
            t = "one "    '*** description for other positions in digit group
        End If
    Case 2: t = "two "
    Case 3: t = "three "
    Case 4: t = "four "
    Case 5: t = "five "
    Case 6: t = "six "
    Case 7: t = "seven "
    Case 8: t = "eight "
    Case 9: t = "nine "
    Case 10: t = "ten "
    Case 11: t = "eleven "
    Case 12: t = "twelve "
    Case 13: t = "thirteen "
    Case 14: t = "fourteen "
    Case 15: t = "fifteen "
    Case 16: t = "sixteen "
    Case 17: t = "seventeen "
    Case 18: t = "eighteen "
    Case 19: t = "nineteen "
    End Select

    Text20 = t    ' apply function result

End Function

Function Text10(Number As Integer) As String
' returns the text description for Number * 10
' *** all 10 string descriptions in this function can be changed for internationalisation purposes

    Dim t As String
    t = ""

    Select Case Number
    Case 1: t = "ten "
    Case 2: t = "twenty "
    Case 3: t = "thirty "
    Case 4: t = "forty "
    Case 5: t = "fifty "
    Case 6: t = "sixty "
    Case 7: t = "seventy "
    Case 8: t = "eighty "
    Case 9: t = "ninety "
    End Select

    Text10 = t

End Function

Copy the Excel VBA
Select the workbook in which you want to store the Excel VBA code
Hold the Alt key, and press the F11 key, to open the Visual Basic Editor
Choose Insert | Module
Where the cursor is flashing, choose Edit | Paste

To use the function in a cell type

=NUMTOTEXT(500.47)

0r to include currency

=NUMTOTEXT(500.47,TRUE,"dollar")