Convert a number to text
There are many versions of a User Defined Function to convert a numeric value to Text. This is one that I adapted to allow the user to specify a Currency to display.
The syntax for the NumToText function is:
NumToText( value, show currency, "currency")
Value: This is the number to convert, it could be a Cell value
show currency: This is a Boolean value, enter True to show thw currency, False not to
Currency: This is a String vriable to be displayed. Enter your choice of currency - "GBP","Eoro", "US Dollar",etc. Again you could have this recorded in a cell.
Here's the code,
- Copy the code that you want to use
- Select the workbook in which you want to store the 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
Option Explicit
Option Base 1 ' the functions will not work properly if this is omitted
Option Compare Text
Function NumToText(Number As Double, ShowCurrency As Boolean, 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
'Here's how to use it in your code
Sub test()
MsgBox Application.WorksheetFunction.Proper(NumToText(125, True, "US Dollars"))
End Sub
Use in a worksheet like this:
Use in a worksheet
=numtotext(125,TRUE,"GBP")
Or
=PROPER(numtotext(125,TRUE,"GBP"))
You can download a workbook example here