Clean Up Phone and Fax Numbers
 

Here's a macro I have for cleaning up fax (or phone) numbers. Our sales
people enter all kinds of random items in the fax field and I use this to
take out all the extra info. I have three questions.

1. How can I take out the double quotation symbol?
2. How can I take out alphabetic characters without listing every single
letter? or is that possible?
3. Is there a better way to do this?

Thank you,
Billy Rogers
Dallas, TX

Sub CleanUP()
Dim c As Range

For Each c In Selection.Cells
c = Replace(c, " ", "")
c = Replace(c, "-", "")
c = Replace(c, ".", "")
c = Replace(c, ",", "")
c = Replace(c, "'", "")
c = Replace(c, "*", "")
c = Replace(c, ";", "")
c = Replace(c, "#", "")
c = Replace(c, "@", "")
c = Replace(c, "^", "")
c = Replace(c, "(", "")
c = Replace(c, ")", "")
c = Replace(c, "$", "")
c = Replace(c, "%", "")
c = Replace(c, "_", "")
c = Replace(c, "\", "")
c = Replace(c, "|", "")
c = Replace(c, "/", "")
c = Replace(c, "<", "")
c = Replace(c, "", "")
c = Replace(c, "?", "")
c = Replace(c, "!", "")
c = Replace(c, "+", "")
c = Replace(c, "`", "")
c = Replace(c, "~", "")
c = Replace(c, "&", "")
c = Replace(c, ":", "")
c = Replace(c, "[", "")
c = Replace(c, "]", "")
c = Replace(c, "{", "")
c = Replace(c, "}", "")



Next

End Sub

Clean Up Phone and Fax Numbers
 

I found this code someone else posted that seems to do what I want and runs
much much quicker than my macro. I'm sorry i lost the post where I found
this and can't give the name of the person who posted it originally. I
renamed it ( the original name was Sub Stripper). It gives you an input box
to determine whether you want to remove letters or numbers. If you choose
letters it removes any non number items-symbols, punctuation,spaces,dashes
etc. It works very well.

Sub RemoveLettersOrNumbers()


Dim myRange As Range
Dim Cell As Range
Dim myStr As String
Dim i As Integer
With Application
..ScreenUpdating = False
..Calculation = xlManual
End With
On Error Resume Next
Set myRange = Range(ActiveCell.Address _
& "," & Selection.Address) _
..SpecialCells(xlCellTypeConstants)
If myRange Is Nothing Then Exit Sub
If Not myRange Is Nothing Then
Which = InputBox("Strip Numbers - Enter 1" & vbCrLf & _
"Strip Letters - Enter 2")
If Which = 2 Then
For Each Cell In myRange
myStr = Cell.Text
For i = 1 To Len(myStr)
If (Asc(UCase(Mid(myStr, i, 1))) < 48) Or _
(Asc(UCase(Mid(myStr, i, 1))) 57) Then
myStr = Left(myStr, i - 1) _
& " " & Mid(myStr, i + 1)
End If
Next i
Cell.Value = Application.Trim(myStr)
Next Cell
Selection.Replace What:=" ", _
Replacement:="", Lookat:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
ElseIf Which = 1 Then
For Each Cell In myRange
myStr = Cell.Text
For i = 1 To Len(myStr)
If (Asc(UCase(Mid(myStr, i, 1))) < 65) Or _
(Asc(UCase(Mid(myStr, i, 1))) 90) Then
myStr = Left(myStr, i - 1) _
& " " & Mid(myStr, i + 1)
End If
Next i
Cell.Value = Application.Trim(myStr)
Next Cell
End If
End If
With Application
..Calculation = xlAutomatic
..ScreenUpdating = True
End With



End Sub