'Solution assumes the original string is in $A$2 in a worksheet
'named "StringsToParse", and the result is returned to $A$3.
'Also assumes that the last alpha substring in the original string
'is what needs to be returned.
'This solution does not require use of the TRIM function.
'It can be modified to iterate any number of cells.
'It can be modified to pull multiple alpha substrings from the
'original string to be concatenated together or otherwise handled.
'Note the simple use of the powerful Regular Expressions object.
'''''''''''''''''''''''''''''''''''''
Option Explicit
Public Sub RemoveNonAlphaFromString()
'Must remove all substrings and spaces except the alphabetic portion.
Dim strOriginal, arrSplit, ctrArray, strFinal, strReturned,
strSubString
strOriginal = Worksheets("StringsToParse").Range("$A$2")
arrSplit = Split(strOriginal, Chr(32), -1, vbTextCompare)
For ctrArray = 0 To UBound(arrSplit)
strSubString = arrSplit(ctrArray)
strReturned = TestStringForAlpha(strSubString)
If strReturned = strSubString Then
'Success. This is the alpabetic substring.
Worksheets("StringsToParse").Range("$A$3") = strReturned
Else
'Failure. This is an unneeded substring.
'Do nothing. Iterate array for next substring.
End If
Next
End Sub
Public Function TestStringForAlpha(strSubString)
Dim objRegExp
Set objRegExp = CreateObject("VBScript.regexp")
With objRegExp
.IgnoreCase = True
.Pattern = "[A-Z]{3}"
.Global = True
If .Test(strSubString) = True Then
TestStringForAlpha = strSubString
Else
'This returned fail code here must not be able
'to match any legitimate substring.
TestStringForAlpha = "99Fail"
End If
End With
End Function