Louise
The following function works quite well for converting numbers to text. The
advantage that it has, over some other 'number to text' code, is that it can
be used for plain numbers, or currencies, and the currency is user
defineable. Unfortunately I don't know who the author is, but thanks to
him/her anyway.
HTH
Cheers,
John
'-----------------------------------------
'Usage:
'With 123456.88 in Cell A1:
'=NumberToText(A1)
'returns "One Hundred Twenty-Three Thousand Four Hundred Fifty-Six and
Eighty-Eight"
'=NumberToText(A1,"Dollars","Cents")
'returns "One Hundred Twenty-Three Thousand Four Hundred Fifty-Six Dollars
and Eighty-Eight Cents"
'In the line -
' sDec = "and " & Trim(HundredsToText(CVar(sDec)) & " " & sCent)
' "and " can be changed to "point "
'so that =NumberToText(A1)
'returns "One Hundred Twenty-Three Thousand Four Hundred Fifty-Six point
Eighty-Eight"
Function NumberToText(Num As Variant, Optional vCurName As Variant, Optional
vCent As Variant) As Variant
Dim TMBT As Variant
Dim sNum As String, sDec As String, sHun As String, IC As Integer
Dim Result As String, sCurName As String, sCent As String
If Application.IsNumber(Num) = False Then
NumberToText = CVErr(xlValue)
Exit Function
End If
If IsMissing(vCurName) Then
sCurName = ""
Else
sCurName = Trim(CStr(vCurName))
End If
If IsMissing(vCent) Then
sCent = ""
Else
sCent = Trim(CStr(vCent))
End If
TMBT = Array("", "Thousand", "Million", "Billion", "Trillion",
"Quadrillion", "Quintillion", "Sextillion")
If IsMissing(sCent) Or IsNull(sCent) Then
sNum = Format(Application.Round(Num, 0), "0")
Else
sNum = Format(Application.Round(Num, 2), "0.00")
sDec = Right(sNum, 2)
sNum = Left(sNum, Len(sNum) - 3)
If CInt(sDec) <> 0 Then
sDec = "and " & Trim(HundredsToText(CVar(sDec)) & " " & sCent)
Else
sDec = ""
End If
End If
IC = 0
While Len(sNum) > 0
sHun = Right(sNum, 3)
sNum = Left(sNum, Application.Max(Len(sNum) - 3, 0))
If CInt(sHun) <> 0 Then
Result = Trim(Trim(HundredsToText(CVar(sHun)) & " " & TMBT(IC)) & " " &
Result)
End If
IC = IC + 1
Wend
Result = Trim(Result & " " & sCurName)
Result = Trim(Result & " " & sDec)
NumberToText = Result
End Function
Function HundredsToText(Num As Integer) As String
Dim Units As Variant, Teens As Variant, Tens As Variant
Dim I As Integer, IUnit As Integer, ITen As Integer, IHundred As Integer
Dim Result As String
Units = Array("", "One", "Two", "Three", "Four", "Five", "Six", "Seven",
"Eight", "Nine")
Teens = Array("Ten", "Eleven", "Twelve", "Thirteen", "Fourteen", "Fifteen",
"Sixteen", "Seventeen", "Eighteen", "Nineteen")
Tens = Array("", "", "Twenty", "Thirty", "Fourty", "Fifty", "Sixty",
"Seventy", "Eighty", "Ninety")
Result = ""
IUnit = Num Mod 10
I = Int(Num / 10)
ITen = I Mod 10
IHundred = Int(I / 10)
If IHundred > 0 Then
Result = Units(IHundred) & " Hundred"
End If
If ITen = 1 Then
Result = Result & " " & Teens(IUnit)
Else
If ITen > 1 Then
Result = Trim(Result & " " & Tens(ITen) & " " & Units(IUnit))
Else
Result = Trim(Result & " " & Units(IUnit))
End If
End If
HundredsToText = Result
End Function
'End Code
'------------------------------------
