Option Explicit
Public Function WordsToNumber(Words As String)
Dim result, tmp
Dim replW, replN
Dim i As Long
result = LCase$(Words)
If Left(result, 2) = "a " Then result = "one " & Mid(result, 3)
'# Cleaning up potentially unwanted symbols - replace with SPACE
replW = Array(",", "-", "_", """", " and ", " ", " ")
For i = LBound(replW) To UBound(replW)
result = Replace(result, replW(i), " ", , , vbTextCompare)
Next i
tmp = SplitUnderThousand(result)
result = SplitOverThousands(tmp)
tmp = Evaluate(result)
If IsError(tmp) Then tmp = result
WordsToNumber = tmp
result = Null
replW = Null
replN = Null
tmp = Null
End Function
Function SplitUnderThousand(ByVal Words As String)
Dim result, tsum
Dim replW, replN
Dim i As Long, j As Long
result = Words
Const hun = "hundred"
'# I have reworked SpellNumber (from MS) to be used in another language, besides English _
I guess a similar thing can be done here, although in Bulgarian it is not too straight-forward
replW = Array("one", "two", "three", "four", "five", _
"six", "seven", "eight", "nine", "ten", _
"eleven", "twelve", "thirteen", "fourteen", "fifteen", _
"sixteen", "seventeen", "eighteen", "nineteen", _
"ninety", "eighty", "seventy", "sixty", "fifty", "forty", "thirty", "twenty")
replN = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19, _
90, 80, 70, 60, 50, 40, 30, 20)
result = Split(result, " ")
For i = LBound(replW) To UBound(replW)
For j = LBound(result) To UBound(result)
If result(j) = replW(i) Then result(j) = "+" & replN(i)
Next j
Next i
tsum = Join(result, " ")
result = Replace(tsum, hun, "*100")
SplitUnderThousand = result
result = Null
replN = Null
replW = Null
End Function
Function SplitOverThousands(ByVal Words As String)
Dim result, tmp, tmp2, tsum
Dim replW, replN
Dim i As Long, j As Long
result = Words
replW = Array("trillion", "billion", "million", "thousand")
replN = Array(10 ^ 12, 10 ^ 9, 10 ^ 6, 1000)
For i = LBound(replW) To UBound(replW)
If InStr(1, result, replW(i), vbTextCompare) Then
result = Split(result, replW(i))
tmp = result(0)
If IsNull(tsum) Then
tsum = tmp & "*" & replN(i)
Else
tsum = tsum & "+(" & tmp & ")*" & replN(i)
End If
result = result(1)
End If
Next i
result = tsum & result
SplitOverThousands = result
End Function
