# Turning nubers into words

Posted by Graham Ashman on May 10, 2001 2:47 AM

Is it possible to turn a numeric currency value into the equivalent words for printing cheques?

Posted by Dave Hawley on May 10, 2001 3:57 AM

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

Posted by Anon on May 10, 2001 4:23 AM

Yes, available from :-

(broken link)

Posted by Kevin James on May 10, 2001 8:00 PM

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