Turning nubers into words

Hi Graham

If you follow my link to my Website you will see another link to "Custom formats" they may be something there that will suit. If not try the link on that page to the MS site about Custom formats. There is a Add-in out there that will do this for you and i think i have the link at my office but I wont be able to get there for 12 hours. If you have no luck send me an email and I will dig it up.

Dave
OzGrid Business Applications

Yes, available from :-

(broken link)

graham:

A person by the name of Celia posted a macro some time ago. Unfortunately I can't find the original posting, but she also provided this info. I have not verified it:

This subject is covered in the following MS Excel knowledge base articles :
Q140704
Q95640
The articles contain sample VBA functions.

Here is the complete transcription of posting Celia made:

Heres a macro by Ole P. Erlandsen
Ole P. Erlandsen
ope@st.telia.no
(broken link)

That I converted to English
Give Credit to Ole
The beauty of this one is you can have larger
numbers + also a currency version.

' Macros written by Ole P. Erlandsen 17.1.1998
'
' For internationalisation, change text in codelines with comments containing '***

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

Function NumToText(Number As Double, ShowCurrency As Boolean) 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
Application.Volatile
NumToText = "Zero" '*** add description for zero values
If Abs(Number) < 0.001 Then
If ShowCurrency Then NumToText = NumToText & " dollars" '*** 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 & "dollars" '*** currency description for 1 unit
Else
NumToText = NumToText & "dollars" '*** 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 & " cents" '*** 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
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, 2) ' get textdescription for <1000 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, 2) & "hundred" & tText '*** add "HUNDREDS" 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<br>' 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 = "førty"
Case 5: t = "fifty"
Case 6: t = "sixty"
Case 7: t = "seventy"
Case 8: t = "eighty"
Case 9: t = "ninty"
End Select
Text10 = t
End Function

Regards

Ivan
Ivan
There is a small amendment required to the function.
For numbers of three digits or more that start with 1, the word conversion starts with “and”.

The following amendment to Function Text100 corrects it (I think) :-

Present code :-

tText = Text20(hPart, 2) & "hundred" & tText '*** add "HUNDREDS" to the description

Revised code :-

tText = Text20(hPart, 1) & "hundred" & tText '*** add "HUNDREDS" to the description