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

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


 

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

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 "

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 "

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

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

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

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

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

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

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

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