part 2 - eliminate rows with special characters

prior code eliminated ALL specials
https://www.experts-exchange.com/questions/29078410/delete-row-if-special-character-in-col-A.html#a42435360
need a reduced version
i would like to NOT delete cells that have the following special characters -

"
,
.
:
;
(
)
&
!
-
finnstoneAsked:
Who is Participating?
 
Bill PrewCommented:
Try changing this line in prior solution:

Case 48 To 57, 65 To 90, 97 To 122

to:

Case 32 To 126


»bp
0
 
Martin LissOlder than dirtCommented:
Sub DeleteRows()
Dim lngLastRow As Long
Dim lngRow As Long
Dim lngChar As Long
Dim lngProgress As Long

Application.ScreenUpdating = False
lngLastRow = Range("A1048576").End(xlUp).Row

For lngRow = lngLastRow To 1 Step -1
    On Error Resume Next
    For lngChar = 1 To Len(Cells(lngRow, "A"))
        lngProgress = lngProgress + 1
        If (lngLastRow - lngRow) Mod 1000 = 0 Then
            Application.StatusBar = lngLastRow - lngRow & " of " & lngLastRow & " processed"
        End If
        If Err.Number <> 0 Then
            Cells(lngRow, "A").EntireRow.Delete
            Exit For
        End If

        Select Case Asc(Mid(Cells(lngRow, "A"), lngChar, 1))
            Case 34, 39, 46, 58, 59, 40, 41, 38, 33, 45
                ' OK
            Case 48 To 57, 65 To 90, 97 To 122
                ' OK
                ' 0 to 9, A to Z, a to z
            Case Else
                Cells(lngRow, "A").EntireRow.Delete
                Exit For
        End Select
    Next
Next
Application.ScreenUpdating = True
Application.StatusBar = False

Open in new window

0
 
Bill PrewCommented:
I would think you would want to include all of 32 to 126, those are all normal characters...

ASCII - Wikipedia


»bp
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
Martin LissOlder than dirtCommented:
So if it was ❤Amy💚! (exclamation point at end) do you want it deleted?
0
 
aikimarkCommented:
What about % characters?
0
 
aikimarkCommented:
This is about as fast a solution as I can suggest.  You can add any characters you want into the pattern.  It performs better if you keep the pattern characters/ranges in ASCII order.
Sub Q_29079748a()
    Dim rng As Range
    Dim oRE As Object
    Dim vData As Variant
    Dim lngSrc As Long
    Dim lngTgt As Long
    
    vData = Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).Value
    
    Set oRE = CreateObject("vbscript.regexp")
    oRE.Global = True
    oRE.Pattern = "[^!""&(),\-\.0-9:;A-Za-z]"
    lngTgt = 1
    On Error Resume Next
    For lngSrc = 1 To UBound(vData, 1)
        If oRE.test(vData(lngSrc, 1)) Then
        Else
            If lngSrc <> lngTgt Then
                vData(lngTgt, 1) = vData(lngSrc, 1)
                lngTgt = lngTgt + 1
            End If
            DoEvents
        End If
    Next
    On Error GoTo 0
    Application.ScreenUpdating = False
    Range(Cells(1, 1), Cells(Rows.Count, 1).End(xlUp)).Clear
    Range("A1").Resize(lngTgt, 1).Value = vData
    Application.ScreenUpdating = True
End Sub

Open in new window

0
 
finnstoneAuthor Commented:
are these DEC or HEX?
0
 
finnstoneAuthor Commented:
OOPS i see it is dec
0
 
Bill PrewCommented:
Not sure who you are asking that too, but my comment:
I would think you would want to include all of 32 to 126, those are all normal characters...
was decimal character codes.


»bp
0
 
Bill PrewCommented:
And just for the heck of it, a somewhat leaner version that might perform better if you have a lot of rows, and long strings in column A.

Sub DeleteRows()
    Dim r As Range
    Dim d As Range
    Dim c As Range
    Dim x As Object
    Dim s As Worksheet

    Set x = CreateObject("vbscript.regexp")
    x.Global = True
    x.Pattern = "[^\x20-\x7E]"

    Set d = Nothing
    Set s = ActiveSheet
    Set r = Range(s.Cells(1, 1), s.Cells(s.Cells.Rows.Count, 1).End(xlUp))
    For Each c In r
        If x.Test(c.Value) Then
            If d Is Nothing Then
                Set d = c
            Else
                Set d = Union(d, c)
            End If
        End If
    Next
    
    d.EntireRow.Delete
End Sub

Open in new window


»bp
1
 
finnstoneAuthor Commented:
thx Bill...how do I specify the partiuclar DEC codes in the leaner version?
0
 
finnstoneAuthor Commented:
also how can i add a search for chinese characters or crazy french or slavic symbols?
0
 
aikimarkCommented:
@finnstone

Was your question addressed to me or Bill or any (future) reader?
0
 
Bill PrewCommented:
thx Bill...how do I specify the partiuclar DEC codes in the leaner version?
You shouldn't need any additional codes with my last (Regex based) approached.  If you do then please be more specific about which characters you want to include, versus exclude.  My approach allows all characters between x20 and x7E (decimal 32 and 126).  Those are the normal printable characters (see below) and would be what you would want I think.  If not, then what characters in that range do you not want, and what characters outside that range do you want to include?

sshot-393.png

»bp
1
 
finnstoneAuthor Commented:
oh nice, so all those other characetsr in that chart will be eliminated?!
0
 
Bill PrewCommented:
Correct.


»bp
0
 
finnstoneAuthor Commented:
Bill, can you take a look at this? see attached. The code is breaking and excel non responding on it (it is deleterows2). this happens often so not sure what format in my data is breaking it.
delete-specia-characters-code---pag.xlsm
0
 
Bill PrewCommented:
I ran it a couple of times here with that data and it worked fine.  Took a few minutes to complete, but it did finish.


»bp
0
 
finnstoneAuthor Commented:
hmm ok i will try working on it.

how about this version of data - i am getting a new  error message about delete row
delete-specia-characters-code---pag.xlsm
0
 
finnstoneAuthor Commented:
user error , disregard!
0
 
finnstoneAuthor Commented:
ok , favor time, can you take a look at this one, it does not run for me. just takes forever and times out. i am trying to run the macro named deleterows2---which is the macro above. if for some reason it runs for you, can you just send me the result :)
delete-specia-characters-code---pag.xlsm
0
 
Bill PrewCommented:
Never finished here after several hours, sorry.  But half million rows is a lot of work, you might have to rethink the problem and solution approach you are using.


»bp
0
 
aikimarkCommented:
Please test my solution
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.