Introduction
This routine is used to convert a string with any number of 'text representations' of a number into a numeric representation of that number. For this code, the number may be located anywhere within the string and may contain decimals, points, dollars, cents, and placement (1st, 2nd, etc.) values. As is, the code returns a list of strings containing (hopefully) every number found in the string given.
Background
I have never submitted code before to this site but have referred to it many times before for help. I have seen so many tutorials on how to convert an integer (or numeric variable) into a string representation of that number (example: 1023 would return "one thousand twenty three" as a string. But I have never seen a reverse implementation. So in essence, I decided to try to write my own. Though it seems to work okay, I am sure there is need for improvement and feedback is always appreciated.
Using the Code
The code is not commented, but hopefully will be easy to follow.
To convert your text, just pass the text to the function via:
Dim ResultString As List(Of String) = TextToNumber(YOURSTRING)
ResultString will then contain a list of strings matching all the numbers found.
Example 1
Dim ResultString As List(Of String) = TextToNumber("One thousand twenty six")
will return ResultString with the following elements:
(0) "1026"
Example 2
Dim ResultString As List(Of String) = _
TextToNumber("Three hundred fourty seven dollars and sixty one cents")
will return ResultString with the following elements:
(0) "$347.61"
Example 3
Dim ResultString As List(Of String) = _
TextToNumber("There are thirty eight kids coming to my sixteenth birthday party")
will return ResultString with the following elements:
(0) "38"
(1) "16th"
Example 4
Dim ResultString As List(Of String) = TextToNumber("The recipe required two point _
five apples out of a bag of 10 apples. Supposedly this recipe will serve twenty-one people. _
It will only cost me eight dollars total. Plus it may net me first place.")
will return ResultString with the following elements:
(0) "2.5"
(1) "1" (The letter a is converted to a one, for strings such as
"a hundred dollars would" return "$100")
(2) "10"
(3) "21"
(4) "$8"
(5) "1st"
If you wish to format the numbers, just do so in the ReturnValue loop at the end of the function which removes empty values.
Public Function TextToNumber(TextAmount As String) As List(Of String)
Dim tSplit() = Strings.Split(TextAmount.Replace("-", " ").ToLower.Trim, " ")
Dim ReturnValue As New List(Of String)
Dim ValueList As New List(Of Double)
Dim Value As Double = 0
Dim Zero As Boolean = False
Dim A As Boolean = False
Dim Dollar As Boolean = False
Dim Minus As Boolean = False
Dim AndDec As Boolean = False
Dim PointDec As Boolean = False
Dim LastOne As String = ""
Dim DecString As String = ""
For Each s As String In tSplit
Select Case s
Case "$", "dollars", "dollar"
Dollar = True
Case "minus"
Minus = True
Case "and", "&"
AndDec = True
A = False
ValueList.Add(Value)
Value = 0
Case "point"
PointDec = True
A = False
ValueList.Add(Value)
Value = 0
DecString &= "."
Case "zero"
Value += 0
If PointDec Then DecString &= "0"
Zero = True
Case "one"
Value += 1
If PointDec Then DecString &= "1"
Case "a"
Value += 1
A = True
Case "two"
Value += 2
If PointDec Then DecString &= "2"
Case "three"
Value += 3
If PointDec Then DecString &= "3"
Case "four"
Value += 4
If PointDec Then DecString &= "4"
Case "five"
Value += 5
If PointDec Then DecString &= "5"
Case "six"
Value += 6
If PointDec Then DecString &= "6"
Case "seven"
Value += 7
If PointDec Then DecString &= "7"
Case "eight"
Value += 8
If PointDec Then DecString &= "8"
Case "nine"
Value += 9
If PointDec Then DecString &= "9"
Case "ten"
Value += 10
Case "eleven"
Value += 11
Case "twelve"
Value += 12
Case "thirteen"
Value += 13
Case "fourteen"
Value += 14
Case "fifteen"
Value += 15
Case "sixteen"
Value += 16
Case "seventeen"
Value += 17
Case "eighteen"
Value += 18
Case "nineteen"
Value += 19
Case "twenty"
Value += 20
Case "thirty"
Value += 30
Case "fourty", "forty"
Value += 40
Case "fifty"
Value += 50
Case "sixty"
Value += 60
Case "seventy"
Value += 70
Case "eighty"
Value += 80
Case "ninety", "ninty"
Value += 90
Case "hundred"
If A And Value = 0 Then Value = 1
Value *= 100
A = False
Case "thousand"
If A And Value = 0 Then Value = 1
Value *= 1000
A = False
ValueList.Add(Value)
Value = 0
Case "million"
If A And Value = 0 Then Value = 1
Value *= 1000000
A = False
ValueList.Add(Value)
Value = 0
Case "billion"
If A And Value = 0 Then Value = 1
Value *= 1000000000
A = False
ValueList.Add(Value)
Value = 0
Case "trillion"
If A And Value = 0 Then Value = 1
Value *= 1000000000000
A = False
ValueList.Add(Value)
Value = 0
Case "quadrillion"
If A And Value = 0 Then Value = 1
Value *= 1000000000000000
A = False
ValueList.Add(Value)
Value = 0
Case Else
If Not Val(s) = 0 And (Val(s).ToString = s) Then Value += Val(s)
If s = "tenths" Or (s = "tenth" And LastOne = "one") Then
Value *= 0.1
ElseIf s = "hundreths" Or s = "cents" Then
Value *= 0.01
ElseIf s = "thousandths" Then
Value *= 0.001
ElseIf s = "millionths" Then
Value *= 0.000001
ElseIf s = "billionths" Or s = "cents" Then
Value *= 0.000000001
ElseIf s = "trillionths" Then
Value *= 0.000000000001
ElseIf PointDec Then
Value = Val(DecString)
End If
Dim tValue As Double = Value
For Each n As Double In ValueList
tValue += n
Next
Dim Place As String = ""
If (Not PointDec) And (Not AndDec) Then
Select Case s
Case "first"
tValue += 1 : Place = "st"
Case "second"
tValue += 2 : Place = "nd"
Case "third"
tValue += 3 : Place = "rd"
Case "fourth", "forth"
tValue += 4 : Place = "th"
Case "fifth"
tValue += 5 : Place = "th"
Case "sixth"
tValue += 6 : Place = "th"
Case "seventh"
tValue += 7 : Place = "th"
Case "eighth"
tValue += 8 : Place = "th"
Case "ninth", "nineth"
tValue += 9 : Place = "th"
Case "tenth"
If (Not (LastOne = "one")) Then tValue += 10 : Place = "th"
Case "eleventh"
tValue += 11 : Place = "th"
Case "twelfth"
tValue += 12 : Place = "th"
Case "thirteenth"
tValue += 13 : Place = "th"
Case "forteenth", "fourteenth"
tValue += 14 : Place = "th"
Case "fifteenth"
tValue += 15 : Place = "th"
Case "sixteenth"
tValue += 16 : Place = "th"
Case "seventeenth"
tValue += 17 : Place = "th"
Case "eighteenth", "eightteenth"
tValue += 18 : Place = "th"
Case "ninteenth", "nineteenth"
tValue += 19 : Place = "th"
Case "twentieth"
tValue += 20 : Place = "th"
Case "thirtieth"
tValue += 30 : Place = "th"
Case "fourtieth", "fortieth"
tValue += 40 : Place = "th"
Case "fiftieth"
tValue += 50 : Place = "th"
Case "sixtieth"
tValue += 60 : Place = "th"
Case "seventieth"
tValue += 70 : Place = "th"
Case "eightieth"
tValue += 80 : Place = "th"
Case "ninetieth", "nintieth"
tValue += 90 : Place = "th"
Case "hundredth"
tValue *= 100 : Place = "th"
Case "thousandth"
tValue *= 1000 : Place = "th"
Case "millionth"
tValue *= 1000000 : Place = "th"
Case "billionth"
tValue *= 1000000000 : Place = "th"
Case "trillionth"
tValue *= 1000000000000 : Place = "th"
End Select
End If
If Minus Then tValue *= -1 : Minus = False
A = False
Dim rAdd As String = ""
If (tValue = 0 And Zero) Or (Not (tValue = 0)) Then
If Dollar Then
rAdd = "$" & tValue.ToString.Trim
Else
rAdd = tValue.ToString.Trim
End If
End If
If Not String.IsNullOrWhiteSpace(Place) Then rAdd &= Place
ReturnValue.Add(rAdd)
Zero = False
Dollar = False
tValue = 0
Value = 0
PointDec = False
AndDec = False
DecString = ""
ValueList.Clear()
End Select
LastOne = s
Next
If PointDec Then Value = Val(DecString)
For Each n As Double In ValueList
Value += n
Next
If Minus Then Value *= -1
If (Value = 0 And Zero) Or (Not (Value = 0)) Then
If Dollar Then
ReturnValue.Add("$" & Value.ToString.Trim)
Else
ReturnValue.Add(Value.ToString.Trim)
End If
End If
For t = ReturnValue.Count - 1 To 0 Step -1
If String.IsNullOrWhiteSpace(ReturnValue(t)) Then ReturnValue.RemoveAt(t)
Next
Return ReturnValue
End Function
Points of Interest
Hopefully, I will be modifying the code to incorporate fractions and percentages as well.
History
- 6th June, 2013: Initial post.
This member has not yet provided a Biography. Assume it's interesting and varied, and probably something to do with programming.
General 
News 
Suggestion 
Question 
Bug 
Answer 
Joke 
Praise 
Rant 
Admin 
Submit an article or tip
