Solved: Convert Number into text automatically

Place that code in a Module. It's probably the best place for it.

Wow. That's a monster. And it works! Give this man some points!!

Wes

It is innovative. I have used a shorter procedure which I wrote back in the BASIC for DOS days. I'll have to do some testing to see which procedure works the fastest.

The only question would be in today's big bucks environment, would there be a need for a billion dollar case?

Jim

bclark100898

Also check
http://www.mvps.org/access/modules/mdl0001.htm

home page is
http://www.mvps.org/access/index.html

click on "Modules" from the list on the left
select "Convert Currency ($500) into words (Five Hundred Dollars)" from the list in upper right frame

---Posted by Joe Foster---

Convert Currency ($500) into words (Five Hundred Dollars)

(Q) I'm looking to have Access convert the currency value "$531.20" into the text "Five hundred thirty one and twenty cents."

(A) Use the following function provided by Joe Foster to convert the Currency into English words.

'************ Code Start **********
'This code was originally written by Joe Foster.
'It is not to be altered or distributed,
'except as part of an application.
'You are free to use it in any application,
'provided the copyright notice is left unchanged.
'
'Code Courtesy of
'Joe Foster
'
' Convert a currency value into an (American) English string
Function English (ByVal N As Currency) As String
Const Thousand = 1000@
Const Million = Thousand * Thousand
Const Billion = Thousand * Million
Const Trillion = Thousand * Billion

If (N = 0@) Then English = "zero": Exit Function

Dim Buf As String: If (N < 0@) Then Buf = "negative " Else Buf = ""
Dim Frac As Currency: Frac = Abs(N - Fix(N))
If (N < 0@ Or Frac <> 0@) Then N = Abs(Fix(N))
Dim AtLeastOne As Integer: AtLeastOne = N >= 1

If (N >= Trillion) Then
Debug.Print N
Buf = Buf & EnglishDigitGroup(Int(N / Trillion)) & " trillion"
N = N - Int(N / Trillion) * Trillion ' Mod overflows
If (N >= 1@) Then Buf = Buf & " "
End If

If (N >= Billion) Then
Debug.Print N
Buf = Buf & EnglishDigitGroup(Int(N / Billion)) & " billion"
N = N - Int(N / Billion) * Billion ' Mod still overflows
If (N >= 1@) Then Buf = Buf & " "
End If

If (N >= Million) Then
Debug.Print N
Buf = Buf & EnglishDigitGroup(N \ Million) & " million"
N = N Mod Million
If (N >= 1@) Then Buf = Buf & " "
End If

If (N >= Thousand) Then
Debug.Print N
Buf = Buf & EnglishDigitGroup(N \ Thousand) & " thousand"
N = N Mod Thousand
If (N >= 1@) Then Buf = Buf & " "
End If

If (N >= 1@) Then
Debug.Print N
Buf = Buf & EnglishDigitGroup(N)
End If

If (Frac = 0@) Then
Buf = Buf & " exactly"
ElseIf (Int(Frac * 100@) = Frac * 100@) Then
If AtLeastOne Then Buf = Buf & " and "
Buf = Buf & Format$(Frac * 100@, "00") & "/100"
Else
If AtLeastOne Then Buf = Buf & " and "
Buf = Buf & Format$(Frac * 10000@, "0000") & "/10000"
End If

English = Buf
End Function

' Support function to be used only by English()
Private Function EnglishDigitGroup (ByVal N As Integer) As String
Const Hundred = " hundred"
Const One = "one"
Const Two = "two"
Const Three = "three"
Const Four = "four"
Const Five = "five"
Const Six = "six"
Const Seven = "seven"
Const Eight = "eight"
Const Nine = "nine"
Dim Buf As String: Buf = ""
Dim Flag As Integer: Flag = False

'Do hundreds
Select Case (N \ 100)
Case 0: Buf = "": Flag = False
Case 1: Buf = One & Hundred: Flag = True
Case 2: Buf = Two & Hundred: Flag = True
Case 3: Buf = Three & Hundred: Flag = True
Case 4: Buf = Four & Hundred: Flag = True
Case 5: Buf = Five & Hundred: Flag = True
Case 6: Buf = Six & Hundred: Flag = True
Case 7: Buf = Seven & Hundred: Flag = True
Case 8: Buf = Eight & Hundred: Flag = True
Case 9: Buf = Nine & Hundred: Flag = True
End Select

If (Flag <> False) Then N = N Mod 100
If (N > 0) Then
If (Flag <> False) Then Buf = Buf & " "
Else
EnglishDigitGroup = Buf
Exit Function
End If

'Do tens (except teens)
Select Case (N \ 10)
Case 0, 1: Flag = False
Case 2: Buf = Buf & "twenty": Flag = True
Case 3: Buf = Buf & "thirty": Flag = True
Case 4: Buf = Buf & "forty": Flag = True
Case 5: Buf = Buf & "fifty": Flag = True
Case 6: Buf = Buf & "sixty": Flag = True
Case 7: Buf = Buf & "seventy": Flag = True
Case 8: Buf = Buf & "eighty": Flag = True
Case 9: Buf = Buf & "ninety": Flag = True
End Select

If (Flag <> False) Then N = N Mod 10
If (N > 0) Then
If (Flag <> False) Then Buf = Buf & "-"
Else
EnglishDigitGroup = Buf
Exit Function
End If

'Do ones and teens
Select Case (N)
Case 0: ' do nothing
Case 1: Buf = Buf & One
Case 2: Buf = Buf & Two
Case 3: Buf = Buf & Three
Case 4: Buf = Buf & Four
Case 5: Buf = Buf & Five
Case 6: Buf = Buf & Six
Case 7: Buf = Buf & Seven
Case 8: Buf = Buf & Eight
Case 9: Buf = Buf & Nine
Case 10: Buf = Buf & "ten"
Case 11: Buf = Buf & "eleven"
Case 12: Buf = Buf & "twelve"
Case 13: Buf = Buf & "thirteen"
Case 14: Buf = Buf & "fourteen"
Case 15: Buf = Buf & "fifteen"
Case 16: Buf = Buf & "sixteen"
Case 17: Buf = Buf & "seventeen"
Case 18: Buf = Buf & "eighteen"
Case 19: Buf = Buf & "nineteen"
End Select

EnglishDigitGroup = Buf
End Function
'************ Code End **********

Dedushka

Hi, CHiLiNVLn.

More than year ago I answered this question and now I found this answer in my archiv
You just need to change FILS to CENTS and KUWAITI DINAR to USD:

-----------------------------------------------------------
The translation of moneys in words from my point of view requires no more than 50 lines of a code (VBA MSA97).

----------
Function say(curAMOUNT As Currency) As String
Dim intTmp As Integer, strAmount As String, strKop As String

strAmount = Format$(curAMOUNT, "#0.000")
strKop = Right(strAmount, 3)
If strKop = "000" Then
strKop = "only"
Else
strKop = "and FILS " & strKop & " only"
End If

strAmount = Left(strAmount, Len(strAmount) - 4)
If strAmount = "0" Then
say = "NO KUWAITI DINAR "
Else
say = "KUWAITI DINAR "
Select Case Len(strAmount) Mod 3
Case 1: strAmount = "00" & strAmount
Case 2: strAmount = "0" & strAmount
End Select
For intTmp = Len(strAmount) \ 3 To 1 Step -1
say = say & say_triada(Mid(strAmount, Len(strAmount) - 3 * intTmp + 1, 3), intTmp)
Next
End If
say = say & strKop
End Function

Function say_triada(ByVal triada As String, ByVal triada_no As Integer) As String
Dim intTemp As Integer, strTemp As String

If triada = "000" And triada_no > 1 Then Exit Function

say_triada = Choose(Left(triada, 1) + 1, "", "One ", "Two ", "Three ", "Four ", _
"Five ", "Six ", "Seven ", "Eight ", "Nine ")
If say_triada <> "" Then say_triada = say_triada & "Houndred "

If Right(triada, 2) > 19 Then
intTemp = Right(triada, 1)
say_triada = say_triada & _
Choose(Mid(triada, 2, 1) + 1, "", "", "Twenty ", "Thirty ", "Forty ", "Fifty ", _
"Sixty ", "Seventy ", "Eighty ", "Ninety ")
Else
intTemp = Right(triada, 2)
End If

say_triada = say_triada & Choose(intTemp + 1, _
"", "One ", "Two ", "Three ", "Four ", "Five ", "Six ", "Seven ", _
"Eight ", "Nine ", "Ten ", "Eleven ", "Twelve ", _
"Thirteen ", "Fourteen ", "Fifteen ", "Sixteen ", _
"Seventeen ", "Eighteen ", "Nineteen ") _
& Choose(triada_no, "", "Thousand ", "Million ", "Billion ", "Trillion ")
End Function
---------
Cheers!
Dedushka

Dedushka

For USD amount first 13 lines must be:

strAmount = Format$(curAMOUNT, "#0.00")
strKop = Right(strAmount, 3)
If strKop = "00" Then
strKop = "only"
Else
strKop = "and CENTS " & strKop & " only"
End If

strAmount = Left(strAmount, Len(strAmount) - 3)
If strAmount = "0" Then
say = "NO USD "
Else
say = "USD "

Dedushka

For USD amount first 13 lines must be:

strAmount = Format$(curAMOUNT, "#0.00")
strKop = Right(strAmount, 2)
If strKop = "00" Then
strKop = "only"
Else
strKop = "and CENTS " & strKop & " only"
End If

strAmount = Left(strAmount, Len(strAmount) - 3)
If strAmount = "0" Then
say = "NO USD "
Else
say = "USD "

Trygve

Would someone like to benchmark these solutions to find the most effective one?

Dedushka

Trigve, I have a new verson of this routine, but it is for Russian rubles so is more complex than for USD. Later I'll rewrite it for USD and it will be more effective than that I post here:-)

Dedushka

Following code is 40 lines only:-)

Public Function Say(curAmount As Currency) As String
Dim intTmp As Integer, strAmount As String, strCent As String

strAmount = Format(curAmount, "#0.00")
strCent = " and " & Right(strAmount, 2) & " cents"
strAmount = Left(strAmount, Len(strAmount) - 3)
If strAmount = "0" Then Say = "No dollars" & strCent: Exit Function

strAmount = Choose((Len(strAmount) Mod 3), "00", "0") & strAmount
For intTmp = Len(strAmount) \ 3 To 1 Step -1
Say = Say & SayTriada(Mid(strAmount, Len(strAmount) - 3 * intTmp + 1, 3), intTmp)
Next
Say = UCase(Left(Say, 1)) & Right(Say, Len(Say) - 1) & "dollars" & strCent

End Function

Public Function SayTriada(ByVal Triada As String, ByVal TriadaNo As Integer) As String
Dim intTemp As Integer, strTemp As String

If Triada = "000" And TriadaNo > 1 Then Exit Function

SayTriada = Choose(Left(Triada, 1) + 1, "", "One ", "Two ", "Three ", "Four ", _
"Five ", "Six ", "Seven ", "Eight ", "Nine ")
If SayTriada <> "" Then SayTriada = SayTriada & "Houndred "
If Right(Triada, 2) > 19 Then
intTemp = Right(Triada, 1)
SayTriada = SayTriada & _
Choose(Mid(Triada, 2, 1) + 1, "", "", "Twenty ", "Thirty ", "Forty ", "Fifty ", _
"Sixty ", "Seventy ", "Eighty ", "Ninety ")
Else
intTemp = Right(Triada, 2)
End If
SayTriada = SayTriada & Choose(intTemp + 1, _
"", "One ", "Two ", "Three ", "Four ", "Five ", "Six ", "Seven ", _
"Eight ", "Nine ", "Ten ", "Eleven ", "Twelve ", _
"Thirteen ", "Fourteen ", "Fifteen ", "Sixteen ", _
"Seventeen ", "Eighteen ", "Nineteen ") _
& Choose(TriadaNo, "", "Thousand ", "Million ", "Billion ", "Trillion ")
End Function

Cheers,
Dedushka

JimMorgan

Dedushka: I learned something with your suggestions. I wasn't aware of the Choose function before. I don't know how I missed that one. I see its been around since VB4 but it isn't something that I was every introduced to. Makes for some tight code.

Thanks for the info.

I threatened this once before and I guess I'll have to dig out the code tomorrow. I remember writing a conversion routine some years ago which I seem to remember was only about 20 lines long and ran like a speed demon.

Jim

wesleystewart

On my machine, Dedushka's Say() function is about twice as fast, taking an average of 400ms to convert all numbers from 100000 to 101111. ssteeve's function averaged just over 700ms.

I think it could be faster if you converted the number to a byte array rather than a string. I'll have to work on it . . .

Wes

wesleystewart

Of course, if you're printing paychecks, it really woudln't matter how slow your function is. It also shouldn't matter if you can handle numbers over a billion. At least not for my paycheck. :)

Wes

wesleystewart

OK, it can't get any faster than this. This function (there are actually two. The first one calls the second) is from the VBA developer's handbook. It takes less than 100ms to run my test described above. Mr. Getz certainly knows his stuff:

Function dhNumToStr(ByVal varValue As Variant) As String
' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' Takes a number and converts it into text for writing
' checks. For example, 24.95 gets converted to
' Twenty-Four and 95/100

' In:
' varValue contains the number to be converted to text
' Out:
' Returns the string or an empty string on any error

On Error GoTo HandleErrors

Dim intTemp As Integer
Dim varNames As Variant
Dim lngDollars As Long
Dim intCents As Integer
Dim strOut As String
Dim strTemp As String
Dim intI As Integer

If Not IsNumeric(varValue) Then Exit Function

' 999,999,999.99 is the largest possible value.
If varValue > 999999999.99 Then Exit Function
varNames = Array("", "Thousand", "Million")

varValue = Abs(varValue)
lngDollars = Int(varValue)
intCents = (varValue - lngDollars) * 100

If lngDollars > 0 Then
' Loop through each set of three digits,
' first the hundreds, then thousands, and then
' millions.
Do
intTemp = lngDollars Mod 1000
lngDollars = Int(lngDollars / 1000)
' Prepend spelling of new triplet of digits to the
' existing output.
If intTemp <> 0 Then
strOut = dhHandleGroup(intTemp) & " " & _
varNames(intI) & " " & strOut
End If
intI = intI + 1
Loop While lngDollars > 0
' Handle the cents.
strOut = RTrim(strOut) & " and " & _
Format$(intCents, "00") & "/100"
End If

ExitHere:
dhNumToStr = strOut
Exit Function

HandleErrors:
' Handle all errors by returning an empty string
strOut = ""
Resume ExitHere
End Function

Private Function dhHandleGroup(ByVal intValue As Integer) As String
' From "VBA Developer's Handbook"
' by Ken Getz and Mike Gilbert
' Copyright 1997; Sybex, Inc. All rights reserved.

' Called by dhNumToStr
Static varOnes As Variant
Static varTens As Variant
Dim strOut As String
Dim intDigit As Integer

If IsEmpty(varOnes) Then
varOnes = Array("", "One", "Two", "Three", "Four", "Five", _
"Six", "Seven", "Eight", "Nine", "Ten", _
"Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen", _
"Sixteen", "Seventeen", "Eighteen", "Nineteen", "Twenty")
End If
If IsEmpty(varTens) Then
' Elements 0 and 1 in this array aren't used.
varTens = Array("", "", "Twenty", "Thirty", "Forty", _
"Fifty", "Sixty", "Seventy", "Eighty", "Ninety")
End If

' Get the hundreds digit, and then the rest.
intDigit = intValue \ 100
intValue = intValue Mod 100

' If there's a hundreds digit, add that now.
If intDigit > 0 Then strOut = varOnes(intDigit) & " Hundred"

' Handle the tens and ones digits.
Select Case intValue
Case 1 To 20
strOut = strOut & varOnes(intValue)
Case 21 To 99
intDigit = intValue \ 10
intValue = intValue Mod 10
If intDigit > 0 Then
strOut = strOut & " " & varTens(intDigit)
End If
If intValue > 0 Then
strOut = strOut & "-" & varOnes(intValue)
End If
End Select

dhHandleGroup = strOut
End Function

CHiLiNVLn

ASKER

Thanks fpr your help. I really appreciate it! Take care!

Dedushka

CHiLiNVLn,
Well done! Let me shake your hand!