[Webinar] Streamline your web hosting managementRegister Today

x
• Status: Solved
• Priority: Medium
• Security: Public
• Views: 680

Convert Number into text automatically

On Access 2000, I have a program designed to print off paychecks for employees on an automatic payroll system.  The system only provides me with there name, date, and pay in dollar amount in a digit field.  Is there a way to interpret the digit and fill in the text automatically.
Example.  \$2,500.00 would write out Two thousand five hundred dollars and ****00 on the check.  Thanks?
0
CHiLiNVLn
• 6
• 4
• 2
• +4
1 Solution

Commented:
Here's a function I wrote for fun one day.  Call it like this:

msgbox(WrittenAmount(3400))

It's pretty big, but here it is:

Function WrittenAmount(x As Currency)
'Takes a numeric amount and translates it to words
Dim Temp As String
Dim Results As String
Dim Negative As Boolean
Dim z As String 'Used in Recursive Call
Dim varDecimal
Dim y

Temp = Trim(Str(x))
Temp = Int(Temp)

varDecimal = Format(x - Int(x), "#.00")

'Check for Negative
If Left\$(Temp, 1) = "-" Then
Negative = True
Temp = Mid\$(Temp, 2, Len(Temp))
End If

If Len(Temp) = 1 Then GoTo Ones
If Len(Temp) = 2 Then GoTo Tens
If Len(Temp) = 3 Then GoTo Hundreds
If Len(Temp) = 4 Then GoTo Thousands
If Len(Temp) = 5 Then GoTo TenThousands
If Len(Temp) = 6 Then GoTo HundredThousands
If Len(Temp) = 7 Then GoTo Millions

Millions:
'Evaluate Millions Place
Select Case Mid\$(Temp, Len(Temp) - 6, 1)
Case 1
Results = Results & "One Million "
Case 2
Results = Results & "Two Million "
Case 3
Results = Results & "Three Million "
Case 4
Results = Results & "Four Million "
Case 5
Results = Results & "Five Million "
Case 6
Results = Results & "Six Million "
Case 7
Results = Results & "Seven Million "
Case 8
Results = Results & "Eight Million "
Case 9
Results = Results & "Nine Million "
End Select

HundredThousands:
'Evaluate Hundred Thousands Place
y = Right\$(Temp, 6)
z = WrittenAmount(Left\$(y, 3))
If Right\$(z, 7) = "Dollars" Then
z = Trim(Mid\$(WrittenAmount(Left\$(y, 3)), 1, Len(WrittenAmount(Left\$(y, 3))) - 7))
End If
If z <> "" Then
Results = Results & z & " Thousand and "
End If
GoTo Hundreds

TenThousands:
'Evaluate Ten Thousands Place
y = Right\$(Temp, 6)
z = WrittenAmount(Left\$(y, 2))
If Right\$(z, 7) = "Dollars" Then
z = Trim(Mid\$(WrittenAmount(Left\$(y, 2)), 1, Len(WrittenAmount(Left\$(y, 2))) - 7))
End If
Results = Results & z & " Thousand and "
GoTo Hundreds

Thousands:
'Evaluate Thousands Place
Select Case Mid\$(Temp, Len(Temp) - 3, 1)
Case 1
Results = Results & "One Thousand "
Case 2
Results = Results & "Two Thousand "
Case 3
Results = Results & "Three Thousand "
Case 4
Results = Results & "Four Thousand "
Case 5
Results = Results & "Five Thousand "
Case 6
Results = Results & "Six Thousand "
Case 7
Results = Results & "Seven Thousand "
Case 8
Results = Results & "Eight Thousand "
Case 9
Results = Results & "Nine Thousand "
End Select

Hundreds:
'Evaluate Hundreds Place
If (Right\$(Results, 4) = "and ") And Mid\$(Temp, Len(Temp) - 2, 1) <> "0" Then
Results = Mid\$(Results, 1, Len(Results) - 4)
End If
If Right\$(Results, 5) = "Thous" Then
Results = Results & "and "
End If
Select Case Mid\$(Temp, Len(Temp) - 2, 1)
Case 1
Results = Results & "One Hundred and "
Case 2
Results = Results & "Two Hundred and "
Case 3
Results = Results & "Three Hundred and "
Case 4
Results = Results & "Four Hundred and "
Case 5
Results = Results & "Five Hundred and "
Case 6
Results = Results & "Six Hundred and "
Case 7
Results = Results & "Seven Hundred and "
Case 8
Results = Results & "Eight Hundred and "
Case 9
Results = Results & "Nine Hundred and "
End Select

Tens:
'Evaluate Ten's Place
Select Case Mid\$(Temp, Len(Temp) - 1, 1)
Case 1
If Right\$(Temp, 2) = 10 Then
Results = Results & "Ten ": GoTo TheEnd
ElseIf Right\$(Temp, 2) = 11 Then
Results = Results & "Eleven ": GoTo TheEnd
ElseIf Right\$(Temp, 2) = 12 Then
Results = Results & "Twelve ": GoTo TheEnd
ElseIf Right\$(Temp, 2) = 13 Then
Results = Results & "Thirteen ": GoTo TheEnd
ElseIf Right\$(Temp, 2) = 14 Then
Results = Results & "Fourteen ": GoTo TheEnd
ElseIf Right\$(Temp, 2) = 15 Then
Results = Results & "Fifteen ": GoTo TheEnd
ElseIf Right\$(Temp, 2) = 16 Then
Results = Results & "Sixteen ": GoTo TheEnd
ElseIf Right\$(Temp, 2) = 17 Then
Results = Results & "Seventeen ": GoTo TheEnd
ElseIf Right\$(Temp, 2) = 18 Then
Results = Results & "Eighteen ": GoTo TheEnd
ElseIf Right\$(Temp, 2) = 19 Then
Results = Results & "Ninteen ": GoTo TheEnd
End If
Case 2
Results = Results & "Twenty "
Case 3
Results = Results & "Thirty "
Case 4
Results = Results & "Fourty "
Case 5
Results = Results & "Fifty "
Case 6
Results = Results & "Sixty "
Case 7
Results = Results & "Seventy "
Case 8
Results = Results & "Eighty "
Case 9
Results = Results & "Ninty "
End Select

Ones:
'Evaluate One's Place
Select Case Right\$(Temp, 1)
Case 1
Results = Results & "One "
Case 2
Results = Results & "Two "
Case 3
Results = Results & "Three "
Case 4
Results = Results & "Four "
Case 5
Results = Results & "Five "
Case 6
Results = Results & "Six "
Case 7
Results = Results & "Seven "
Case 8
Results = Results & "Eight "
Case 9
Results = Results & "Nine "
End Select
GoTo TheEnd

TheEnd:

If Right\$(Trim(Results), 4) = " and" Then
Results = Trim(Mid\$(Results, 1, Len(Results) - 4))
End If

If Negative = True Then
Results = "Negative " & Results
End If
If Right\$(Results, 1) <> " " Then
Results = Results & " Dollars"
Else
Results = Results & "Dollars"
End If

If Left\$(varDecimal, 1) = "." Then
varDecimal = Right\$(varDecimal, 2)
varDecimal = Val(varDecimal)
End If
Dim a
If varDecimal <> 0 Then
a = WrittenAmount(Val(varDecimal))
If Right\$(a, 7) = "Dollars" Then
a = Trim(Mid\$(a, 1, Len(a) - 7))
End If
End If
If a <> "" Then Results = Results & " and " & a & " Cents."
WrittenAmount = Results
End Function
0

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

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

Wes
0

Commented:
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
0

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

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 **********

0

Commented:
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

Dim intTemp As Integer, strTemp  As String

say_triada = Choose(Left(triada, 1) + 1, "", "One ", "Two ", "Three ", "Four ", _
"Five ", "Six ", "Seven ", "Eight ", "Nine ")

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

"", "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
0

Commented:
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 "
0

Commented:
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 "
0

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

Commented:
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:-)
0

Commented:
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

Dim intTemp As Integer, strTemp As String

SayTriada = Choose(Left(Triada, 1) + 1, "", "One ", "Two ", "Three ", "Four ", _
"Five ", "Six ", "Seven ", "Eight ", "Nine ")
If Right(Triada, 2) > 19 Then
Choose(Mid(Triada, 2, 1) + 1, "", "", "Twenty ", "Thirty ", "Forty ", "Fifty ", _
"Sixty ", "Seventy ", "Eighty ", "Ninety ")
Else
End If
"", "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
0

Commented:
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
0

Commented:
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
0

Commented:
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
0

Commented:
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

' 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

' 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

0

Author Commented:
Thanks fpr your help. I really appreciate it!  Take care!
0

Commented:
CHiLiNVLn,
Well done! Let me shake your hand!
0

Featured Post

• 6
• 4
• 2
• +4
Tackle projects and never again get stuck behind a technical roadblock.