SPELLNUMBERREVERSE

Returns the number equivalent for a number written as text.
You can use the SPELLNUMBER function to go in the opposite direction.

This requires a reference to the Microsoft Scripting Runtime.
link - https://contexturesblog.com/archives/2011/10/21/words-to-numbers-in-excel/


sMyTextNumber - The text you want to convert to a number. 

Public Function SPELLNUMBERREVERSE( _
    ByVal sMyTextNumber As Variant) As Variant

Dim odictionary As Scripting.Dictionary
Dim sValidation As String
Dim arwords As Variant
Dim slastword As String
Dim lmultiple As Long
Dim lngRes As Long

    On Error GoTo ErrorHandler
    Set odictionary = StringToLong_Dictionary
    lmultiple = 1
    sMyTextNumber = VBA.LCase(sMyTextNumber)
    
    If (sMyTextNumber Like "*,*") Then
        sMyTextNumber = Replace(sMyTextNumber, ",", "")
    End If
    
    sValidation = StringToLong_Validation(odictionary, sMyTextNumber)
    If (Len(sValidation) > 0) Then
        SPELLNUMBERREVERSE = sValidation
        Exit Function
    End If
    
    If (odictionary.Exists(sMyTextNumber) = True) Then
        lngRes = odictionary.Item(sMyTextNumber)
    Else
        arwords = VBA.Split(sMyTextNumber, " ")
        Do While VBA.Len(sMyTextNumber) > 0
            slastword = arwords(UBound(arwords))
            Select Case slastword
                Case "and":
                Case "hundred":
                                 If (lmultiple = 1000) Then
                                     lmultiple = 100000
                                 Else: lmultiple = 100
                                 End If
                Case "thousand": lmultiple = 1000
                Case Else:
                    If (odictionary.Exists(slastword) = True) Then
                        lngRes = lngRes + (odictionary.Item(slastword) * lmultiple)
                    End If
            End Select
            sMyTextNumber = VBA.Trim(VBA.Left(sMyTextNumber, VBA.InStrRev(sMyTextNumber, " ")))
            arwords = VBA.Split(sMyTextNumber, " ")
        Loop
    End If

    SPELLNUMBERREVERSE = lngRes
    Exit Function
    
ErrorHandler:
    SPELLNUMBERREVERSE = "Error"
End Function

Private Function StringToLong_Validation( _
    ByVal objDictionary As Scripting.Dictionary, _
    ByVal sMyTextNumber As Variant) As String
    
Dim sError As String
Dim arwords As Variant
Dim lcount As Long
Dim ltemp As Long

    On Error GoTo ErrorHandler
    StringToLong_Validation = False
        
    arwords = VBA.Split(sMyTextNumber, " ")
    For lcount = 0 To UBound(arwords)
        If objDictionary.Exists(arwords(lcount)) = False Then
            sError = "Spelling mistake"
            StringToLong_Validation = sError
            Exit Function
        End If
    Next lcount
        
    If (VBA.InStr(1, sMyTextNumber, "thousand") > 0) Then
        If (VBA.Right(sMyTextNumber, 8) <> "thousand") Then
        
            If (VBA.InStr(InStr(1, sMyTextNumber, "thousand"), sMyTextNumber, "hundred") > 0) Then
                If (VBA.InStr(1, sMyTextNumber, "thousand and") > 0) Then
                    sError = "Invalid 'and' after the thousand"
                    StringToLong_Validation = sError
                    Exit Function
                End If
            Else
                If (VBA.InStr(1, sMyTextNumber, "thousand and") = 0) Then
                    sError = "Missing 'and' after the thousand"
                    StringToLong_Validation = sError
                    Exit Function
                End If
            End If
        End If
    End If
    
    If (VBA.InStr(1, sMyTextNumber, "hundred") > 0) Then
        If (VBA.Right(sMyTextNumber, 7) <> "hundred") Then
            If ((VBA.InStr(1, sMyTextNumber, "hundred and") = 0) And _
                (VBA.InStr(1, sMyTextNumber, "hundred thousand") = 0)) Then
                sError = "Missing 'and' after the hundred"
                StringToLong_Validation = sError
                Exit Function
            End If
        End If
        
        If (VBA.InStr(1, sMyTextNumber, "thousand") > 0) Then
            sMyTextNumber = VBA.Mid(sMyTextNumber, VBA.InStr(1, sMyTextNumber, "thousand") + 9)
        End If
        
        If (VBA.InStr(1, sMyTextNumber, "hundred") > 0) Then
            ltemp = VBA.InStr(1, sMyTextNumber, "hundred")
            sMyTextNumber = VBA.Left(sMyTextNumber, ltemp + 6)
            
            If ((sMyTextNumber <> "one hundred") And _
                (sMyTextNumber <> "two hundred") And _
                (sMyTextNumber <> "three hundred") And _
                (sMyTextNumber <> "four hundred") And _
                (sMyTextNumber <> "five hundred") And _
                (sMyTextNumber <> "six hundred") And _
                (sMyTextNumber <> "seven hundred") And _
                (sMyTextNumber <> "eight hundred") And _
                (sMyTextNumber <> "nine hundred")) Then
                
                sError = "You cannot have more than 9 hundreds"
                StringToLong_Validation = sError
                Exit Function
            End If
        End If
    End If
    StringToLong_Validation = ""
    Exit Function
    
ErrorHandler:
    StringToLong_Validation = sError
End Function

Private Function StringToLong_Dictionary() As Scripting.Dictionary
Dim objDictionary As Scripting.Dictionary
    Set objDictionary = New Scripting.Dictionary
    objDictionary.Add "one", 1
    objDictionary.Add "two", 2
    objDictionary.Add "three", 3
    objDictionary.Add "four", 4
    objDictionary.Add "five", 5
    objDictionary.Add "six", 6
    objDictionary.Add "seven", 7
    objDictionary.Add "eight", 8
    objDictionary.Add "nine", 9
    objDictionary.Add "ten", 10
    objDictionary.Add "eleven", 11
    objDictionary.Add "twelve", 12
    objDictionary.Add "thirteen", 13
    objDictionary.Add "fourteen", 14
    objDictionary.Add "fifteen", 15
    objDictionary.Add "sixteen", 16
    objDictionary.Add "seventeen", 17
    objDictionary.Add "eighteen", 18
    objDictionary.Add "nineteen", 19
    objDictionary.Add "twenty", 20
    objDictionary.Add "thirty", 30
    objDictionary.Add "forty", 40
    objDictionary.Add "fifty", 50
    objDictionary.Add "sixty", 60
    objDictionary.Add "seventy", 70
    objDictionary.Add "eighty", 80
    objDictionary.Add "ninety", 90
    
    objDictionary.Add "hundred", -1
    objDictionary.Add "thousand", -1
    objDictionary.Add "and", -1
    Set StringToLong_Dictionary = objDictionary
End Function

© 2020 Better Solutions Limited. All Rights Reserved. © 2020 Better Solutions Limited TopPrevNext