VBA Code Spelled numbers to number
VBA function that takes a spelled number and returns the number in digits.
Example:
WordsToNumber("one thousand six hundred thirty four")
will return 1634
There is an online version of this converter if you wan to try it:
Spelled number converter – Paracon Consultants Corp. (paracons.ca)
<<Code Start>>
' ----------------------------------------------------------------
' Procedure Name: WordsToNumber
' Purpose: Converts a spelled numbers to numbers
' Procedure Kind: Function
' Procedure Access: Public
' Parameter SpelledNumber (String): Number in words example; "one thousand six hundred thirty four"
' Return Type: Double
'
' Author: PARACON CONSULTANTS CORP.
' Website: https://paracons.ca
' eMail: info@paracons.ca
' Date: 7/8/2022
' ----------------------------------------------------------------
Function WordsToNumber(SpelledNumber As String) As Double
Dim sWords As Variant
Dim w As Long
Dim i As Long
Dim n As Long
Dim nResult As Double
SpelledNumber = VBA.Trim(SpelledNumber)
If SpelledNumber = vbNullString Then Exit Function
'removing redundant characters
SpelledNumber = VBA.Replace(SpelledNumber, "-", " ")
SpelledNumber = VBA.Replace(SpelledNumber, " ", " ")
SpelledNumber = VBA.Replace(SpelledNumber, " and ", " ")
'forming an array with the words
sWords = VBA.Split(SpelledNumber, " ")
'parsing the simple numbers
For w = LBound(sWords) To UBound(sWords)
Select Case sWords(w)
'getting the single digit
Case "one": sWords(w) = 1
Case "two": sWords(w) = 2
Case "three": sWords(w) = 3
Case "four": sWords(w) = 4
Case "five": sWords(w) = 5
Case "six": sWords(w) = 6
Case "seven": sWords(w) = 7
Case "eight": sWords(w) = 8
Case "nine": sWords(w) = 9
'getting the teens
Case "eleven": sWords(w) = 11
Case "twelve": sWords(w) = 12
Case "thirteen": sWords(w) = 13
Case "fourteen": sWords(w) = 14
Case "fifteen": sWords(w) = 15
Case "sixteen": sWords(w) = 16
Case "seventeen": sWords(w) = 17
Case "eighteen": sWords(w) = 18
Case "nineteen": sWords(w) = 19
'getting the tens
Case "ten": sWords(w) = 10
Case "twenty": sWords(w) = 20
Case "thirty": sWords(w) = 30
Case "forty", "fourty": sWords(w) = 40
Case "fifty": sWords(w) = 50
Case "sixty": sWords(w) = 60
Case "seventy": sWords(w) = 70
Case "eighty": sWords(w) = 80
Case "ninety": sWords(w) = 90
'replacing the 10 multipliers with 0 digits as place holders
Case "hundred", "hundreds": sWords(w) = "00"
Case "thousand", "thousands": sWords(w) = "000"
Case "million", "millions": sWords(w) = "000000"
Case "billion", "billions", "bil": sWords(w) = "000000000"
Case "trillion", "trillions": sWords(w) = "000000000000"
End Select
Next w
'now applying the multiplier. This is the tricky part that took a lot of thinking.
For w = LBound(sWords) To UBound(sWords) - 1
n = 0 'n will store the number of 0 zeros in the last applied multiplier
'if this is a number an not a multiplier
If VBA.CDbl(sWords(w)) > 0 Then
'applying the relevant multipliers from the next records
For i = w + 1 To UBound(sWords)
'if this is a mulitplier for example "00"
If VBA.CDbl(sWords(i)) = 0 Then
'if the number of zeros in this multiplier is more than the previous one then it is applicable
If Len(sWords(i)) > n Then
'adding the multiplier's zeros to the right of the number
sWords(w) = sWords(w) & sWords(i)
'storing the number of zeros in the new multiplier
n = Len(sWords(i))
'if the number of zeros in this multiplier isn't more than the previous one,
'then there are no more relevant multipliers to the current number
Else
Exit For
End If
End If
Next i
End If
Next w
'summing all the numbers in the sWords array
For w = LBound(sWords) To UBound(sWords)
nResult = nResult + VBA.CDbl(sWords(w))
Next w
WordsToNumber = nResult
End Function
<<Code End>>
Leave a comment