SPELLNUMBERREVERSE

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

'strSource - The text description you want to convert. Valid strings are 1 to 999,999 inclusive
'lngRes - The numerical value after successful conversion
'strError - A description of why the conversion was not successful

Public Function SPELLNUMBERREVERSE( _
    ByVal strSource As Variant, _
    ByRef lngRes As Variant, _
    ByRef strError As Variant) As Variant

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

    On Error GoTo ErrorHandler
    Set odictionary = StringToLong_Dictionary
    lmultiple = 1
    strSource = VBA.LCase(strSource)
    
    If (StringToLong_Validation(odictionary, strSource, lngRes, strError) = False) Then
        StringToLong = False
        Exit Function
    End If
    
    If (odictionary.Exists(strSource) = True) Then
        lngRes = odictionary.Item(strSource)
    Else
        arwords = VBA.Split(strSource, " ")
        Do While VBA.Len(strSource) > 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
            strSource = VBA.Trim(VBA.Left(strSource, VBA.InStrRev(strSource, " ")))
            arwords = VBA.Split(strSource, " ")
        Loop
    End If

    strError = Empty
    SPELLNUMBERINVERSE = True
    Exit Function
    
ErrorHandler:
    lngRes = Empty
    strError = "Error"
    StringToLong = False
End Function

Private Function StringToLong_Validation( _
    ByVal objDictionary As Scripting.Dictionary, _
    ByVal strSource As Variant, _
    ByRef lngRes As Variant, _
    ByRef strError As Variant) As Boolean
    
Dim arwords As Variant
Dim lcount As Long

    On Error GoTo ErrorHandler
    StringToLong_Validation = False
    
    If (strSource Like "*,*") Then
        strError = "Punctuation characters are not allowed"
        Exit Function
    End If
    
    arwords = VBA.Split(strSource, " ")
    For lcount = 0 To UBound(arwords)
        If objDictionary.Exists(arwords(lcount)) = False Then
            strError = "Spelling mistake"
            Exit Function
        End If
    Next lcount
        
    If (VBA.InStr(1, strSource, "thousand") > 0) Then
        If (VBA.Right(strSource, 8) <> "thousand") Then
        
            If (VBA.InStr(InStr(1, strSource, "thousand"), strSource, "hundred") > 0) Then
                If (VBA.InStr(1, strSource, "thousand and") > 0) Then
                    strError = "Invalid 'and' after the thousand"
                    Exit Function
                End If
            Else
                If (VBA.InStr(1, strSource, "thousand and") = 0) Then
                    strError = "Missing 'and' after the thousand"
                    Exit Function
                End If
            End If
        End If
    End If
    
    If (VBA.InStr(1, strSource, "hundred") > 0) Then
        If (VBA.Right(strSource, 7) <> "hundred") Then
            If ((VBA.InStr(1, strSource, "hundred and") = 0) And _
                (VBA.InStr(1, strSource, "hundred thousand") = 0)) Then
                strError = "Missing 'and' after the hundred"
                Exit Function
            End If
        End If
        
        If (VBA.InStr(1, strSource, "thousand") > 0) Then
            strSource = VBA.Mid(strSource, VBA.InStr(1, strSource, "thousand") + 9)
        End If
        If (VBA.InStr(1, strSource, "hundred") > 0) Then
            strSource = VBA.Left(strSource, VBA.InStr(1, strSource, "hundred") + 6)
            If ((strSource <> "one hundred") And _
                (strSource <> "two hundred") And _
                (strSource <> "three hundred") And _
                (strSource <> "four hundred") And _
                (strSource <> "five hundred") And _
                (strSource <> "six hundred") And _
                (strSource <> "seven hundred") And _
                (strSource <> "eight hundred") And _
                (strSource <> "nine hundred")) Then
                strError = "You cannot have more than 9 hundreds"
                Exit Function
            End If
        End If
    End If
    StringToLong_Validation = True
    Exit Function
    
ErrorHandler:
    lngRes = Empty
    strError = "Error"
    StringToLong_Validation = False
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


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