# Freebee - Numbers as Text

Posted by Rob Jackson on August 09, 2001 8:19 AM

This was a solution to an issue earlier. May be useful to others...

Interesting problem, so I wrote this. It works from 0 to 99999 and all you need to do is add dollars or cents on the end. Just call the first function IntegerToText passing a Long number as the value you want to convert. You will need to call it once for dollar values and once for cent values as it only works on whole numbers.

Function IntegerToText(ByVal Num As Long)

Dim TextNum As String

Dim NumStr As String

Dim LenNum As Integer

If Num < 0 Then

Num = Num * (-1)

End If

TextNum = CStr(Fix(Num))

LenNum = Len(TextNum)

Select Case LenNum

Case 1

NumStr = Xval("0" & TextNum)

Case 2

NumStr = Xval(Right(TextNum, 2))

Case 3

If CInt(Right(TextNum, 2)) = 0 Then

NumStr = Xval("0" & Left(TextNum, 1)) & Units(3)

Else

NumStr = Xval("0" & Left(TextNum, 1)) & Units(3) & "and " & IntegerToText(CInt(Right(TextNum, 2)))

End If

Case 4

If CInt(Right(TextNum, 3)) = 0 Then

NumStr = Xval("0" & Left(TextNum, 1)) & Units(4)

ElseIf CInt(Right(TextNum, 3)) < 100 Then

NumStr = Xval("0" & Left(TextNum, 1)) & Units(4) & "and " & IntegerToText(CInt(Right(TextNum, 3)))

Else

NumStr = Xval("0" & Left(TextNum, 1)) & Units(4) & " " & IntegerToText(CInt(Right(TextNum, 3)))

End If

Case 5

If CInt(Right(TextNum, 3)) = 0 Then

NumStr = Xval(Left(TextNum, 2)) & Units(5)

ElseIf CInt(Right(TextNum, 3)) < 100 Then

NumStr = Xval(Left(TextNum, 2)) & Units(5) & "and " & IntegerToText(CInt(Right(TextNum, 3)))

Else

NumStr = Xval(Left(TextNum, 2)) & Units(5) & " " & IntegerToText(CInt(Right(TextNum, 3)))

End If

Case Else

' Nothing Happens

End Select

IntegerToText = NumStr

End Function

Function Units(ByVal Utype As Integer)

Select Case Utype

Case 1

Units = ""

Case 2

Units = ""

Case 3

Units = "Hundred "

Case 4

Units = "Thousand "

Case 5

Units = "Thousand "

End Select

End Function

Function Xval(ByVal Tval As String)

Select Case Tval

Case "00"

Xval = "Zero "

Case "01"

Xval = "One "

Case "02"

Xval = "Two "

Case "03"

Xval = "Three "

Case "04"

Xval = "Four "

Case "05"

Xval = "Five "

Case "06"

Xval = "Six "

Case "07"

Xval = "Seven "

Case "08"

Xval = "Eight "

Case "09"

Xval = "Nine "

Case "10"

Xval = "Ten "

Case "11"

Xval = "Eleven "

Case "12"

Xval = "Twelve "

Case "13"

Xval = "Thirteen "

Case "14"

Xval = "Fourteen "

Case "15"

Xval = "Fifteen "

Case "16"

Xval = "Sixteen "

Case "17"

Xval = "Seventeen "

Case "18"

Xval = "Eighteen "

Case "19"

Xval = "Nineteen "

End Select

Select Case Left(Tval, 1)

Case "2"

If Right(Tval, 1) = 0 Then

Xval = "Twenty"

Else

Xval = "Twenty - " & Xval("0" & Right(Tval, 1))

End If

Case "3"

If Right(Tval, 1) = 0 Then

Xval = "Thirty"

Else

Xval = "Thirty - " & Xval("0" & Right(Tval, 1))

End If

Case "4"

If Right(Tval, 1) = 0 Then

Xval = "Forty"

Else

Xval = "Forty - " & Xval("0" & Right(Tval, 1))

End If

Case "5"

If Right(Tval, 1) = 0 Then

Xval = "Fifty"

Else

Xval = "Fifty - " & Xval("0" & Right(Tval, 1))

End If

Case "6"

If Right(Tval, 1) = 0 Then

Xval = "Sixty"

Else

Xval = "Sixty - " & Xval("0" & Right(Tval, 1))

End If

Case "7"

If Right(Tval, 1) = 0 Then

Xval = "Seventy"

Else

Xval = "Seventy - " & Xval("0" & Right(Tval, 1))

End If

Case "8"

If Right(Tval, 1) = 0 Then

Xval = "Eighty"

Else

Xval = "Eighty - " & Xval("0" & Right(Tval, 1))

End If

Case "9"

If Right(Tval, 1) = 0 Then

Xval = "Ninety"

Else

Xval = "Ninety - " & Xval("0" & Right(Tval, 1))

End If

End Select

End Function

This can probably be improved upon but it was a interesting challenge and I don't have the time available to refine it further. It will do the job though.

hope its suitable...

Rob