Filter for cells containing non-alphanumeric characters

[JackDanIce]

Hi,

I have a column with string values, in which some cells contain non alphanumeric characters, remaining cells contain alphanumeric only.

Does anyone have any VBA code suggestions on how to create two columns from this initial column?

I can only think of the following:

Dim myArray as Variant
myArray = Array("|","\","[","]","/") ' Full array to have characters: _ - ' ; / \ | "[] {} () + = % # $% @ * . ! ?

Dim LR as Long: LR = Range("A" & Rows.Count).End(xlUp).Row
Dim x as Long

For x = 0 to Ubound(myArray)
  Columns(1).AutoFilter Field:=1, Criteria1:=myArray(x), operator:=xlFilterValue
  ' Code to move visible cells elsewhere, then clear filtered results
Next x

Is there a faster way to achieve this or any code to filter for all non-alphanumeric characters and move those cells in a single pass? Alternatively, if I can filter for cells ONLY containing alphanumerica characters, then that can work too (since the left overs will be non-alphanumeric).

Thanks in advance,
Jack

 

[XLfriend777]

Hi JackDanIce - Interesting problem. I was playing around with the code below and just searched for "," or "_" and then if found it copied the value to the next column, but it wa probably not as efficient as you already have. Hope this helped.

Sub JackDanIce_Find_String()
Dim i As Integer
Dim FindChar1, FindChar2 As String
Dim SearchString As String
Dim status As String
status = "Alpha Only"
 
For Each c In Range("A1:A5")
c.Select
SearchString = c.value
    For i = 1 To Len(SearchString)
    FindChar1 = ","
    FindChar2 = "_"
    
        If Mid(SearchString, i, 1) = FindChar1 Or Mid(SearchString, i, 1) = FindChar2 Then
            status = "non-alpha"
            
'If non-alpha is found then c.value is copied to c.Offset(0,1).Value
            If status = "non-alpha" Then
                c.Offset(0, 1).value = c.value
            End If
            
        End If
    Next i
Next c
End Sub

 

[mikerickson]

try

If testString Like "*[!A-Z0-9a-z]*" Then
    MsgBox "there is a non alphanumeric chr in " & testString
End If

 

[XLfriend777]

Hi mikerickson and JackDanIce - Much more elegant. Thanks for the advice mikerickson!

Sub JackDanIce_Find_String2()
Dim testString As String
 
For Each c In Range("A1:A15")
c.Select
testString = c.value
    If testString Like "*[!A-Z0-9a-z]*" Then
        c.Offset(0, 1).value = c.value
    End If
Next c
End Sub

 

[JackDanIce]

Thanks goesr and mikerickson.

mikerickson, I'd seen something like that before but couldn't get it to work in a like statement, hence setting up an array of all the characters and looping through it - your solution, much easier, thank you very much.

However, the actual requirement is there is a sheet with >500k rows and I'd like to separate into a new sheet, any row where column A contains a non-alphanumeric character. Are there any faster ways to separate the data instead of using a loop through each cell in column A?

 

[JackDanIce]

This code does what I need and compared to the second code (with column A filled to row 524,289), it's significantly faster:

Loop through an array

Sub m2()
' Load values into an array and process
Dim rng As Range: Set rng = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
Dim x As Variant: x = rng.Value
Dim i As Long

Application.ScreenUpdating = False

For i = LBound(x) To UBound(x)
    If x(i, 1) Like "*[!A-Z0-9a-z]*" Then
        x(i, 1) = vbNullString
    End If
Next i

rng.Offset(, 1).Value = x
Erase x


Application.ScreenUpdating = True


End Sub

Loop through each cell

Sub m1()
Dim x As Long
Application.ScreenUpdating = False

For x = 2 To Range("A" & Rows.Count).End(xlUp).Row

    If Range("A" & x).Value Like "*[!A-Z0-9a-z]*" Then
        With Range("A" & x)
            Range("B" & x).Value = .Value
            .ClearContents
        End With
    End If

Next x
    
Application.ScreenUpdating = True
End Sub

Thanks again and if this is useful to anyone else reading or searching for a similar problem.