[AccessD] Number to Words

On 19 May 2009 at 7:38, Rocky Smolin wrote:

> Dear List:
> 
> I have a requirement to convert a number to it's equivalent into words.
> Found a couple of functions on the web.  So it looks pretty straightforward.
> Cut and paste. 
> 
> But does anybody have any favorites.  Or warnings?
> 

Here's my own routine to do it for money.  It would be very simple to tweak it slightly if you  
want to use it for negative numbers (use Abs() and stick the word "Negative " or "Minus" at 
the start of the string), whole numbers (just drop all the "cents" part) or for varying decimal 
places ( a bit more work).

Function moneywords(amount As Double) As String
If  amount = 0  Then moneywords = "Nothing": Exit Function
Dim dollar As Long
Dim hundredthousands As Long
Dim thousands As Long
Dim hundreds As Long
Dim tens As Long
Dim units As Long
Dim cents As Long
Dim money As String
dollar = Int(amount)
cents = (amount - dollar) * 100
thousands = Int(dollar / 1000)
millions = Int(dollar / 1000000)
hundredthousands = Int((dollar - (millions * 1000000)) / 100000)
thousands = Int((dollar - (millions * 1000000) - (hundredthousands * 100000)) / 1000)
hundreds = Int((dollar - (millions * 1000000) _
    - (hundredthousands * 100000) - (thousands * 1000)) / 100)
units = dollar - (millions * 1000000) - (hundredthousands * 100000) _
    - thousands * 1000 - hundreds * 100
If dollar = 0 Then money = "Zero"

Select Case millions
Case 1 To 19
money = unitword(millions) & " Million"
Case 20 To 99
money = money & " " & Trim(teenword(Int(millions / 10)) & _
   " " & unitword(millions - Int(millions / 10) * 10)) & " Million"
Case Is > 99
moneywords = "AT LEAST one hundred million dollar!"
Exit Function
End Select

Select Case hundredthousands
Case 1 To 9
money = money & " " & unitword(hundredthousands) & " Hundred"
End Select

Select Case thousands
Case 0
If hundredthousands > 0 Then money = money & " Thousand"
Case 1 To 19
If hundredthousands > 0 Then money = money & " and"
money = money & " " & unitword(thousands) & " Thousand"
Case 20 To 99
If hundredthousands > 0 Then money = money & " and"
money = money & " " & Trim(teenword(Int(thousands / 10)) & _
  " " & unitword(thousands - Int(thousands / 10) * 10)) & " Thousand"
End Select

Select Case hundreds
Case 1 To 9
money = money & " " & unitword(hundreds) & " Hundred"
End Select
If (millions + hundredthousands + thousands + hundreds) > 0 _
    And units > 0 Then money = money & " and"

Select Case units
Case 1 To 19
money = money & " " & unitword(units)
Case 20 To 99
money = money & " " & Trim(teenword(Int(units / 10)) & _
  " " & unitword(units - Int(units / 10) * 10))
End Select
money = money & " dollar"

Select Case cents
Case 0
money = money & " Only"
Case 1 To 19
money = money & " and " & unitword(cents) & " cents Exactly"
Case 20 To 99
money = money & " and " & Trim(teenword(Int(cents / 10)) & _
  " " & unitword(cents - Int(cents / 10) * 10)) & " cents Exactly"
End Select

moneywords = money
End Function

Function teenword(amount) As String
Dim unitname(9) As String
unitname(2) = "Twenty"
unitname(3) = "Thirty"
unitname(4) = "Forty"
unitname(5) = "Fifty"
unitname(6) = "Sixty"
unitname(7) = "Seventy"
unitname(8) = "Eighty"
unitname(9) = "Ninety"
teenword = unitname(amount)
End Function

Function unitword(amount) As String
Dim unitname(19) As String

unitname(1) = "One"
unitname(2) = "Two"
unitname(3) = "Three"
unitname(4) = "Four"
unitname(5) = "Five"
unitname(6) = "Six"
unitname(7) = "Seven"
unitname(8) = "Eight"
unitname(9) = "Nine"
unitname(10) = "Ten"
unitname(11) = "Eleven"
unitname(12) = "Twelve"
unitname(13) = "Thirteen"
unitname(14) = "Fourteen"
unitname(15) = "Fifteen"
unitname(16) = "Sixteen"
unitname(17) = "Seventeen"
unitname(18) = "Eighteen"
unitname(19) = "Nineteen"
unitword = unitname(amount)
End Function