need macro to clean up telephone numbers

G

Guest

I have two columns (A:B) of data in my spreadsheet where people enter
telephone numbers. To enforce the integrity of the data in these columns, I
need a macro that will select columns A:B and remove all non-numerical
characters. 0-9 is all I want. I need to remove spaces and the a host of
other things such as dash, slash, dot, and parenthesis.
I have a macro that trims the leading spaces, and runs through a long
find/replace routine, but I wondered if there is a more graceful and better
way to remove everything that isn't a number 0-9 from these range of cells.

For example: 919-123-4567 or 919.123.4567 would become 9191234567

Any suggestions?
 
A

ankur

Hi There,


Try the following function


Function CleanedNumber(RawNumber) As String

CleanedNumber1 = ""

For i = 1 To Len(RawNumber)

If IsNumeric(Mid(RawNumber, i, 1)) = True Then
CleanedNumber = CleanedNumber & Mid(RawNumber, i, 1)
End If

Next i

End Function


Put this function in any Module and then in the worksheet use this as
a formula. Like EX. +CleanedNumber (A1)


Let me know if you can make it.

Regards
Richard / Ankur
www.xlmacros.com
 
G

Guest

How about:

Function num_part(r As Range) As Double
v = r.Value
l = Len(v)
v2 = ""
For i = 1 To l
vt = Mid(v, i, 1)
If vt Like "#" Then
v2 = v2 & vt
End If
Next
num_part = v2 * 1
End Function
 
G

Guest

I don't quite know what to do with this. This does not compile as an Excel
VBA macro, and I don't understand where you specified the range.
 
G

Guest

This is not a macro it is a function. It goes in a standard module:

from the worksheet open VBE:
ALT-F11

from VBE open a fresh module
ALT-I
ALT-M

paste the function in and close the VBE window.


In the worksheet use it like:

=num_part(A14)

In a function, the range is passed as an argument. For example:

=SUM(A2:A50)

the range is A2:A50.

If you have more questions or problems, just update this post.
 
D

Don Guillett

formula
=SUBSTITUTE(SUBSTITUTE(A2,"-",""),".","")
macro
Sub trimphn()
For Each c In Range("a1:b21")
c.Value = Replace(c, "-", "")
c.Value = Replace(c, ".", "")
Next
End Sub
 
G

Guest

Sub GetDigits()

Dim i As Long
Dim mycell As Range
Dim str As String, s As String, res As String

For Each mycell In Selection
str = mycell
For i = 1 To Len(str)
s = Mid(str, i, 1)
res = res & IIf(s Like "[0-9]", s, "")
Next i
mycell = res
res = ""
Next mycell

End Sub

And in case you might want to be flexable about removing either alpha or
numeric in one procedure......

Sub RemoveLettersOrNumbers()

Dim myRange As Range
Dim cell As Range
Dim MyStr As String, Which As String
Dim i As Integer

MsgBox ("This macro will only leave you with numbers or letters it will
not leave characters" & _
" such as !@#$%^&*()-+=\")

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
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top