Remove special characters from range in VBA

Question

I have created a VBA code to remove all special characters available in a column. As an example I have a Alphanumeric character with some special characters in every cells of a column: Suppose in a cell I have a value: abc@123!-245 After executing my code I got output abc 123 245 Here my code is working fine to remove all the special characters. My code is given below:

Sub ReplaceSpecial()
    Dim cel As Range
    Dim strVal As String
    Dim i As Long
    Application.ScreenUpdating = False
    For Each cel In Selection
        strVal = cel.Value
        For i = 1 To Len(strVal)
            Select Case Asc(Mid(strVal, i, 1))
                Case 32, 48 To 57, 65 To 90, 97 To 122
                    ' Leave ordinary characters alone
                Case Else
                    Mid(strVal, i, 1) = " "
            End Select
        Next i
        cel.Value = strVal
    Next cel
    Application.ScreenUpdating = True
End Sub

Now if I want to remove the space for my output so that output should look like abc123245, how to do that in VBA? Input: abc@123!-245 Current Output: abc 123 245 Required Output: abc123245

Answer 1

You could construct a new string with just the permitted characters.

Sub ReplaceSpecial()
    Dim cel As Range
    Dim strVal As String, temp As String
    Dim i As Long
    Application.ScreenUpdating = False
    For Each cel In Selection
        strVal = cel.Value
        temp = vbNullString
        For i = 1 To Len(strVal)
            Select Case Asc(Mid(strVal, i, 1))
                Case 32, 48 To 57, 65 To 90, 97 To 122
                    temp = temp & Mid(strVal, i, 1)                   
            End Select
        Next i
        cel.Value = temp
    Next cel
    Application.ScreenUpdating = True
End Sub

Answer 2

My sole intention for this late post was to

• test some features of the ►Application.Match() function (comparing a string input against valid characters) and to
• demonstrate a nice way to "split" a string into single characters as alternative and possibly instructive solution (see help function String2Arr()).

I don't intend, however to show better or faster code here.

Application.Match() allows not only to execute 1 character searches in an array, but to compare even two arrays in one go, i.e. a character array (based on an atomized string input) against an array of valid characters (blanks, all digits and chars from A to Z). As Application.Match is case insensitive, it suffices to take e.g. lower case characters.

All findings of input chars return their position in the valid characters array (otherwise resulting in Error 2042). Furthermore it was necessary to exclude the wild cards "*" and "?", which would have been considered as findings otherwise.

Function ValidChars(ByVal s, Optional JoinResult As Boolean = True)
'Purp: return only valid characters if space,digits,"A-Z" or "a-z"
    'compare all string characters against valid characters
    Dim tmp: tmp = foundCharAt(s)   ' get array with found positions in chars
    'overwrite tmp array
    Dim i As Long, ii As Long
    For i = 1 To UBound(tmp)
        If IsNumeric(tmp(i)) Then                   ' found in valid positions
            If Not Mid(s, i, 1) Like "[?*]" Then    ' exclude wild cards
                ii = ii + 1
                tmp(ii) = Mid(s, i, 1)  ' get char from original string
            End If
        End If
    Next
    ReDim Preserve tmp(1 To ii)         ' reduce to new size
    'join tmp elements to resulting string (if argument JoinResult = True)
    ValidChars = IIf(JoinResult, Join(tmp, ""), tmp)
End Function

Help function foundCharAt()

Returns an array of found character positions in the valid chars array:

Function foundCharAt(ByVal s As String) As Variant
'Purp: return array of found character positions in chars string
'Note: (non-findings show Error 2042; can be identified by IsError + Not IsNumeric)
    Dim chars: chars = String2Arr(" 0123456789abcdefghijklmnopqrstuvwxyz")
    foundCharAt = Application.Match(String2Arr(s), chars, 0)
End Function

Help function String2Arr()

Assigns an array of single characters after atomizing a string input:

Function String2Arr(ByVal s As String) As Variant
'Purp: return array of all single characters in a string
'Idea: https://stackoverflow.com/questions/13195583/split-string-into-array-of-characters
    s = StrConv(s, vbUnicode)
    String2Arr = Split(s, vbNullChar, Len(s) \ 2)
End Function

Answer 3

Use a regular expression's object and replace all unwanted characters by using a negated character class. For demonstration purposes:

Sub Test()

Dim str As String: str = "abc@123!-245"

With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "[^0-9A-Za-z ]"
    str = .Replace(str, "")
End With

Debug.Print str

End Sub

The pattern [^0-9A-Za-z ] is a negated character class and captured everything that is not a alphanumeric or a space character. You'll find a more in-depth explaination in this online demo.

At time of writing I'm unsure if you want to leave out the space characters or not. If so, just remove the space from the pattern.

---

Thought I'd chuck in another alternative using the Like() operator:

For i = Len(str) To 1 Step -1
    If Mid(str, i, 1) Like "[!0-9A-Za-z ]" Then
        str= Application.Replace(str, i, 1, "")
    End If
Next

Or with a 2nd string-type variable (as per @BigBen's answer):

For i = 1 to Len(str)
    If Mid(str, i, 1) Like "[0-9A-Za-z ]" Then
        temp = temp & Mid(str, i, 1)
    End If
Next

Answer 4

If you want to build on your current effort, replace:

cel.Value = strVal

with:

cel.Value = Replace(strVal, " ", "")

Consider:

Sub ReplaceSpecial()
    Dim cel As Range
    Dim strVal As String
    Dim i As Long
    Application.ScreenUpdating = False
    For Each cel In Selection
        strVal = cel.Value
        For i = 1 To Len(strVal)
            Select Case Asc(Mid(strVal, i, 1))
                Case 32, 48 To 57, 65 To 90, 97 To 122
                    ' Leave ordinary characters alone
                Case Else
                    Mid(strVal, i, 1) = " "
            End Select
        Next i
        cel.Value = Replace(strVal, " ", "")
    Next cel
    Application.ScreenUpdating = True
End Sub