Remove Non-numeric or Non-alpha characters...

[Bryniac]

I really need a macro to delete all non-numeric character or all non-alpha character within each cell in a selection

I was trying to do it with a For each loop or with "=ISNUMBER()" formula but I couldn't, I really have no idea how to refer to the content of each cell, or non-numeric character.

Sub non_numeric ()

Dim cell as range

For each cell in Intersect(ActiveSheet.UsedRange, Selection)
'
'remove non- numeric characters
'
Next cell

End Sub

Please I'll really appreciate it, I work with lists that have tons of Phone numbers.[and they always have (_,)- .( to remove]

Thanks in Advanced

 

[JoeMo]

This code will allow you to select the cells then choose the type of characters you want to remove from each cell.

Sub RemoveCharacters()
'---------------------------------------------------------------------
'There are 6 sections to this module, each is called indvidually
'to perform one of the following functions:
'1)Remove numeric characters from all cells in a selection
'2)Remove alphabetic characters from all cells in a selection
'3)Remove non-numeric characters from all cells in a selection
'4)Remove non-alphabetic characters from all cells in a selection
'5)Remove non-alpha-numeric characters from all cells in a selection
'6)Remove non-printable characters from all cells in a selection
'Results can be erratic if selected cells contain formulas that use CHAR() function
'Best used on non-formulaic cells
'---------------------------------------------------------------------
Dim rng As Range, c As Range, Ans, msg As String
msg = "Select a range for removal of character type you will specify next." & vbNewLine
msg = msg & "Select multiple ranges by holding down the ctrl key."
On Error Resume Next
Set rng = Application.InputBox(msg, Type:=8)
If rng Is Nothing Then Exit Sub  'Cancel clicked
On Error GoTo 0
msg = "Enter 1 to remove numeric characters from your selection" & vbNewLine & vbNewLine
msg = msg & "Enter 2 to remove alphabetic characters from your selection" & vbNewLine & vbNewLine
msg = msg & "Enter 3 to remove non-numeric characters from your selection" & vbNewLine & vbNewLine
msg = msg & "Enter 4 to remove non-alphabetic characters from your selection" & vbNewLine & vbNewLine
msg = msg & "Enter 5 to remove non-alpha-numeric characters from your selection" & vbNewLine & vbNewLine
msg = msg & "Enter 6 to remove non-printable characters from your selection"

Ans = InputBox(msg, "CHOOSE CHARACTER TYPE")
If Ans = "" Then Exit Sub
With Application
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
    .EnableEvents = False
End With
For j = 1 To rng.Areas.Count
    Select Case Ans
        Case 1: Call RemoveNumeric(rng.Areas(j))
        Case 2: Call RemoveAlpha(rng.Areas(j))
        Case 3: Call RemoveNonNumeric(rng.Areas(j))
        Case 4: Call RemoveNonAlpha(rng.Areas(j))
        Case 5: Call RemoveNonAlphaNumeric(rng.Areas(j))
        Case 6: Call RemoveNonPrintable(rng.Areas(j))
        Case Else: MsgBox "Entry must be from 1 to 6": Exit Sub
    End Select
Next j
With Application
    .Calculation = xlCalculationAutomatic
    .ScreenUpdating = True
    .EnableEvents = True
End With
End Sub
Sub RemoveNumeric(rng As Range)
'1) Remove all numeric characters
For i = 48 To 57
    For Each c In rng
        If Not IsEmpty(c) And Not IsError(c) Then
            If InStr(1, c.Value, Chr(i)) > 0 Then
                c.Replace Chr(i), "", xlPart
            End If
        End If
    Next c
Next i
End Sub
Sub RemoveAlpha(rng As Range)
'2) Remove alphabetic characters
For i = 65 To 90
    For Each c In rng
        If Not IsEmpty(c) And Not IsError(c) Then
            If InStr(1, UCase(c.Value), Chr(i)) > 0 Then
                c.Replace Chr(i), "", xlPart  'Upper case letters
                c.Replace Chr(i + 32), "", xlPart  'Lower case Letters
            End If
        End If
    Next c
Next i
End Sub
Sub RemoveNonNumeric(rng As Range)
'3) Remove non-numeric characters (numeric chars are 48-57)
For i = 0 To 47
    For Each c In rng
        If Not IsEmpty(c) And Not IsError(c) Then
            If InStr(1, c.Value, Chr(i)) > 0 Then
                c.Replace Chr(i), "", xlPart
            End If
        End If
    Next c
Next i
For i = 58 To 255
    For Each c In rng
        If Not IsEmpty(c) And Not IsError(c) Then
            If InStr(1, c.Value, Chr(i)) > 0 Then
                c.Replace Chr(i), "", xlPart
            End If
        End If
    Next c
Next i
End Sub
Sub RemoveNonAlpha(rng As Range)
'4) Remove non-alphabetic characters
For i = 0 To 64
    For Each c In rng
        If Not IsEmpty(c) And Not IsError(c) Then
            If InStr(1, c.Value, Chr(i)) > 0 Then
                c.Replace Chr(i), "", xlPart
            End If
        End If
    Next c
Next i
For i = 91 To 96
    For Each c In rng
        If Not IsEmpty(c) And Not IsError(c) Then
            If InStr(1, c.Value, Chr(i)) > 0 Then
                c.Replace Chr(i), "", xlPart
            End If
        End If
    Next c
Next i
For i = 123 To 255
    For Each c In rng
        If Not IsEmpty(c) And Not IsError(c) Then
            If InStr(1, c.Value, Chr(i)) > 0 Then
                c.Replace Chr(i), "", xlPart
            End If
        End If
    Next c
Next i
End Sub
Sub RemoveNonAlphaNumeric(rng As Range)
'5)Remove non-alpha-numeric characters
For i = 0 To 47
    For Each c In rng
        If Not IsEmpty(c) And Not IsError(c) Then
            If InStr(1, c.Value, Chr(i)) > 0 Then
                c.Replace Chr(i), "", xlPart
            End If
        End If
    Next c
Next i
For i = 58 To 64
    For Each c In rng
        If Not IsEmpty(c) And Not IsError(c) Then
            If InStr(1, c.Value, Chr(i)) > 0 Then
                c.Replace Chr(i), "", xlPart
            End If
        End If
    Next c
Next i
For i = 91 To 96
    For Each c In rng
        If Not IsEmpty(c) And Not IsError(c) Then
            If InStr(1, c.Value, Chr(i)) > 0 Then
                c.Replace Chr(i), "", xlPart
            End If
        End If
    Next c
Next i
For i = 123 To 255
    For Each c In rng
        If Not IsEmpty(c) And Not IsError(c) Then
            If InStr(1, c.Value, Chr(i)) > 0 Then
                c.Replace Chr(i), "", xlPart
            End If
        End If
    Next c
Next i
End Sub
Sub RemoveNonPrintable(rng As Range)
'6)Remove non-printable characters
For i = 0 To 31
    For Each c In rng
        If Not IsEmpty(c) And Not IsError(c) Then
            If InStr(1, c.Value, Chr(i)) > 0 Then
                c.Replace Chr(i), "", xlPart
            End If
        End If
    Next c
Next i
End Sub