Phone number insanity

[Dragonflight]

I'm working on a thousand-line database, and we need to streamline the data to a uniform format. The data was provided from all over the place, so the phone number data is formatted in just about every way there is. For example:

(123) 456-7890 <--- this is the desired result
1-234-567-8900
123-4567
123-456-7890
123- 456-7890
123 456 7890

The thought of having to go through this list manually horrifies me. It's got two phone numbers, cell, pager, fax, and alternate contact numbers, all done up in this jumble. Manual formatting would drive me insane. Is there a way to fix this problem faster?

 

[Theadish]

You should just be able to format one of them, copy it, then do a paste special - Formats on all the other numbers.

 

[Smitty]

This may be a start:

Sub ConvertPhoneNumbers()
    With Range([A1], [A65536].End(xlUp))
        .Replace What:="-", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False
        .Replace What:=" ", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False
        .NumberFormat = "[<=9999999]###-####;(###) ###-####"
    End With
End Sub

Hope that helps,

Smitty

 

[chiello]

(123) 456-7890 <--- this is the desired result
1-234-567-8900
123-4567
123-456-7890
123- 456-7890
123 456 7890

Your "desired result" is made by 10 digits, while not all raw data have the same lenght.
What doing in this case?

 

[Dragonflight]

The data was compiled from a number of different departments. Each department has a varying degree of enthusiasm for this project, and a varying degree of interest in providing the information we require in the format we require. It's been like pulling teeth to get this much. To turn around and demand they format it properly first means we'll probably never get it all. So formatting this mess was dropped on me. @_@

The code above worked very well, except for one detail. Any entry formatted in the correct manner was altered. For instance:

(123) 456-7890
became
(123)456-7890

Also, someone mentioned above doing a copy->paste special as Format. I tried that first thing with cells, and the whole column. Nothing. I guess it's because although they're a mess, they're all also technically different accepted phone number formats, and the computer can't tell them apart. Or something. I'm guessing here. But it didn't change the contents of the cell.

 

[Joe Was]

Using PennySaver's
This should do most formats?

Sub ConvertPhoneNumbers()
'Sheet module code, like: Sheet1.
Dim c As Range
Dim myLen

With Range([A1], [A65536].End(xlUp))
.Replace What:="-", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False
End With
For Each c In Range([A1], [A65536].End(xlUp))
myLen = Len(c)
If myLen = 11 Then
c.NumberFormat = "#(###) ###-####"
End If
If myLen = 10 Then
c.NumberFormat = "(###) ###-####"
End If
If myLen = 7 Then
c.NumberFormat = "###-####"
End If
Next c
End Sub

 

[Dragonflight]

The code works extremely well, which means I gotta be doing *something* wrong on my end.

The data has some numbers already properly formatted. But when the macro runs, it changes that by stripping out the spaces and dashes.

I go from:
(123) 456-7890
to
(123)4567890

What am I missing?

Thanks for this btw. Nothing more frustrating than the clueless. Which is why it's so frustrating to BE clueless in the field.

 

[Seti]

Try this one with a couple small adjustments. Kudos to Joe though.

Added replacing "(" and ")" with nothing and getting rid of leading 1 on long distance numbers.

Sub ConvertPhoneNumbers()
'Sheet module code, like: Sheet1.
Dim c As Range
Dim myLen

With Range([A1], [A65536].End(xlUp))
    .Replace What:="-", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
    .Replace What:=" ", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
    .Replace What:="(", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
    .Replace What:=")", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
End With
For Each c In Range([A1], [A65536].End(xlUp))
    myLen = Len(c)
    If myLen = 11 Then
        c = Right(c, 10)
        myLen = 10
    End If
    If myLen = 10 Then
        c.NumberFormat = "(###) ###-####"
    End If
    If myLen = 7 Then
        c.NumberFormat = "###-####"
    End If
Next c
End Sub

 

[Dragonflight]

Awesome, simply awesome. You guys are the best!

Works like a charm! Thanks guys!

 

[PA HS Teacher]

Assuming you only care about the characters that are numbers, and moving from right to left, I worked out this User Defined Function.
Here's to variety:

Function Phone(Num As String) As String
' *****  Formats Number/Text of any format to Desired Phone Format ***************
' This UDF looks from the right side of the string and accepts the first 10 digits
' as the numbers to be included in the phone number.  All non numeric numbers are ignored
' Each Digit is stored in sNumArr Starting from the right and moving leftward until all
' 10 digits have been accepted.

Dim sNumArr(1 To 14) As String, C As Integer, Position As Integer
Position = 14
sNumArr(1) = "("             'Position of desired Formatting Characters
sNumArr(5) = ")"
sNumArr(6) = " "
sNumArr(10) = "-"

For i = Len(Num) To 1 Step -1
If Position > 1 Then
  C = Asc(Mid(Num, i, 1))          ' ASCII Number Corresponding to this Character
  If C< 48 Or C > 57 Then
                                   'Don't includ this character in Phone Number
  Else
    sNumArr(Position) = Chr(C)
    Position = Position - 1
    If Position = 10 Then Position = 9     'Makes sure digits do not overwrite
    If Position = 6 Then Position = 4      'Desired Formatting Characters
    If Position = 5 Then Position = 4
  End If
End If
Next i
Num = ""
For i = 1 To 14
  Phone = Phone & sNumArr(i)
Next i
End Function

Phone Number formatter.xls
	A	B	C	D
1	=Phone()UDF	AsEntered
2	(123)456-7890	(123)456-7890<---thisisthedesiredresult
3	(234)567-8900	1-234-567-8900
4	(896)354-9698	A1-896BC354*96U98
5	(745)783-7647	UI^7)45+78&t3X76E4@7
6	()123-4567	123-4567
7	(123)456-7890	123-456-7890
8	(123)456-7890	123-456-7890
9	(123)456-7890	1234567890
10	(208)740-1989	12345-193208740198-9
Sheet1