VBA Code Spelled numbers to number

VBA function that takes a spelled number and returns the number in digits.


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
' 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

                        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

This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

You may also like

View all
Excel VBA Get Applied Filter Criteria
VBA Code Spelled numbers to number
Excel: How to Case Sensitive Vlookup formula
How to unprotect Excel sheet without password
Installing Primavera on SQL Server