Replace first three digits of phone number if = 000.

[9tanstaafl9]

I have managed to clean up some very messy phone numbers, but have one small remaining problem. Some numbers were only 7 digits long to begin with, and I ended up with a range of phone numbers that look something like this:

000 123-4567
425 111-1111
425 222-2222
425 333-0000

I need to be able to replace the 000 AREA CODE with a number provided via an input box for the local area code. But I need to NOT replace any other 000's in the phone number.

Could someone please point me in the right direction?


Here is my code so far:

Sub FixFubarFormatting()
'Note, I cobbled this together from other posts and help I received on mrexcel.com

'Selects the range to run the macro on
On Error Resume Next
Dim userRange As Range
Set userRange = Application.InputBox(Prompt:="Please highlight the entire range of phone numbers to be converted - including blank cells.", Title:="Range Select", Type:=8)
userRange.Select

'Inserts an extra column to deal with extensions.  Delete if not applicable.
Selection.Offset(0, 1).EntireColumn.Insert

'attempts to split out extensions entered into phone field
On Error Resume Next
    With Selection
        .Replace "~*", "§", xlPart
        .Replace "#", "§", xlPart
        .Replace "extension", "§", xlPart
        .Replace "ext:", "§", xlPart
        .Replace "ext", "§", xlPart
        .Replace "ex", "§", xlPart
        .Replace "x", "§", xlPart
        .Replace ":", "§", xlPart
        Application.DisplayAlerts = False
        
        .TextToColumns other:=True, OtherChar:="§", ConsecutiveDelimiter:=True
        
    End With
    
'Removes nonnumeric cells and formats number correctly

On Error Resume Next
    Dim c As Range
    Dim i As Long
    Dim sTemp As String
    If Not TypeOf Selection Is Range Then Exit Sub
    For Each c In Selection
        sTemp = vbNullString
        For i = 1 To Len(c.Value)
            If IsNumeric(Mid(c.Value, i, 1)) Then sTemp = sTemp & Mid(c.Value, i, 1)
        Next
        c.Value = sTemp
        If Len(c) = 11 Then c = Right(c, 10)
        c.NumberFormatLocal = "000 000-0000" 'change this to match formatting you prefer
    Next
    
'Note the numbers are really without spaces or dashes. Cell value for 123 456-789 is 123456789

'Make real values match formatting (can delete this if not needed for data conversion purposes)
  Dim Cell As Range
  On Error GoTo NoFilledCells
  For Each Cell In Selection.SpecialCells(xlCellTypeConstants)
    Cell.Value = Format(Replace(Cell.Value, "-", ""), "000 000-0000")
  Next
NoFilledCells:

'makes it pretty
Selection.HorizontalAlignment = xlCenter
Selection.Offset(0, 1).HorizontalAlignment = xlCenter

'replace 000 with preferred area code if desired.
'xxxxxxxthis is the part I need to figure out

Thanks for any help!
Jen

 

[9tanstaafl9]

SOLVED!

I figured out a workaround. Instead of trying to search for the 000 (which I still can't figure out how to do), I just told it to look for 7 digit numbers and add the area code if needed.

Sub FixFubarFormatting()
'Note, I cobbled this together from other posts and help I received on mrexcel.com
'Just posting in case it might help someone else.

'Selects the range to run the macro on
On Error Resume Next
Dim userRange As Range
Set userRange = Application.InputBox(Prompt:="Please highlight the entire range of phone numbers to be converted - including blank cells.", Title:="Range Select", Type:=8)
userRange.Select

'Inserts an extra column to deal with extensions.  Delete if not applicable.
Selection.Offset(0, 1).EntireColumn.Insert


'attempts to split out extensions entered into phone field
On Error Resume Next
    With Selection
        .Replace "~*", "§", xlPart
        .Replace "#", "§", xlPart
        .Replace "extension", "§", xlPart
        .Replace "ext:", "§", xlPart
        .Replace "ext", "§", xlPart
        .Replace "ex", "§", xlPart
        .Replace "x", "§", xlPart
        .Replace ":", "§", xlPart
        Application.DisplayAlerts = False
        
        .TextToColumns other:=True, OtherChar:="§", ConsecutiveDelimiter:=True
        
    End With
    
'Removes nonnumeric cells and formats number correctly

On Error Resume Next
    Dim myArea As Variant
    myArea = Application.InputBox("Please enter a three digit area code for use with 7 digit phone numbers.")
    Dim c As Range
    Dim i As Long
    Dim sTemp As String
    If Not TypeOf Selection Is Range Then Exit Sub
    For Each c In Selection
        sTemp = vbNullString
        For i = 1 To Len(c.Value)
            If IsNumeric(Mid(c.Value, i, 1)) Then sTemp = sTemp & Mid(c.Value, i, 1)
        Next
        c.Value = sTemp
        If Len(c) = 11 Then c = Right(c, 10)
        If Len(c) = 7 Then c.Value = myArea & c  'fixes seven digit phone numbers
        c.NumberFormatLocal = "000 000-0000" 'change this to match formatting you prefer
    Next
    
'Note the numbers are really without spaces or dashes. Cell value for 123 456-789 is 123456789

'Make real values match formatting (can delete this if not needed for your data conversion purposes)
  Dim Cell As Range
  On Error GoTo NoFilledCells
  For Each Cell In Selection.SpecialCells(xlCellTypeConstants)
    Cell.Value = Format(Replace(Cell.Value, "-", ""), "000 000-0000")
  Next
NoFilledCells:

'makes it pretty
Selection.HorizontalAlignment = xlCenter
Selection.Offset(0, 1).HorizontalAlignment = xlCenter
    
End Sub