remove all special characetrs, except for space

finnstone
finnstone used Ask the Experts™
on
this code removes special characeters but it also removes spaces and i need to keep spaces. any help aprpeciated!

Sub DeleteNonAlphaNumericChars()
Dim Constants As Range
Dim Char As String
Dim Txt As String
Dim Cell As Range
Dim i As Integer
' Change sheet name as needed:
Const SheetName = "Sheet1"
Set Constants = ThisWorkbook.Sheets( _
SheetName).Cells.SpecialCells( _
xlCellTypeConstants)
For Each Cell In Constants
Txt = vbNullString
For i = 1 To Len(Cell.Text)
Char = Mid(Cell.Text, i, 1)
Select Case Asc(Char)
Case Asc("0") To Asc("9"):
Txt = Txt & Char
Case Asc("a") To Asc("z"):
Txt = Txt & Char
Case Asc("A") To Asc("Z"):
Txt = Txt & Char
End Select
Next i
Cell.Value = Txt
Next Cell
End Sub
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Bill PrewTest your restores, not your backups...
Top Expert 2016
Commented:
Try this:

Sub DeleteNonAlphaNumericChars()
    Dim Constants As Range
    Dim Char As String
    Dim Txt As String
    Dim Cell As Range
    Dim i As Integer
    ' Change sheet name as needed:
    Const SheetName = "Sheet1"
    Set Constants = ThisWorkbook.Sheets( _
    SheetName).Cells.SpecialCells( _
    xlCellTypeConstants)
    For Each Cell In Constants
        Txt = vbNullString
        For i = 1 To Len(Cell.Text)
            Char = Mid(Cell.Text, i, 1)
            Select Case Asc(Char)
                Case Asc(" "):
                    Txt = Txt & Char
                Case Asc("0") To Asc("9"):
                    Txt = Txt & Char
                Case Asc("a") To Asc("z"):
                    Txt = Txt & Char
                Case Asc("A") To Asc("Z"):
                    Txt = Txt & Char
            End Select
        Next i
        Cell.Value = Txt
    Next Cell
End Sub

Open in new window


»bp
Consulting
Distinguished Expert 2017
Commented:
Hi,

It will be shorter and easyer to read with a regex:
Sub DeleteNonAlphaNumericChars()
    Dim Constants As Range
    Dim Cell As Range
    Dim rx As Object

        ' Change sheet name as needed:
    Const SheetName = "Sheet1"
    Set Constants = ThisWorkbook.Sheets(SheetName).Cells.SpecialCells(xlCellTypeConstants)
    Set rx = CreateObject("VBScript.RegExp")
    rx.Pattern = "[^0-9A-Za-z ]"
    For Each Cell In Constants
        Cell.value = rx.Replace(Cell.Value, vbNullString)
    Next Cell
    Set rx = Nothing
    Set Constants  = Nothing
End Sub

Open in new window

Note: The regex pattern can also be "[^\d\w  ]"

Author

Commented:
thanks Bill. I have 40k rows. It says no repsonding. I will check it in the morning but i dont tihnk its running well
CompTIA Network+

Prepare for the CompTIA Network+ exam by learning how to troubleshoot, configure, and manage both wired and wireless networks.

Bill PrewTest your restores, not your backups...
Top Expert 2016

Commented:
Yes, the original approach was pretty heavy in processing, so adding another condition would only slow it down further.

Have you tried the REGEX approach?


»bp
Bill PrewTest your restores, not your backups...
Top Expert 2016
Commented:
You will need to add the  second line shown below to the REGEX approach.  In tests here it runs way faster than the character by character approach, go with it.

    rx.Pattern = "[^0-9A-Za-z ]"
    rx.Global = True

Open in new window


»bp

Author

Commented:
would that be line 10 and 11 bill?

Author

Commented:
wow regex worked in like 1 second

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial