Format Phone Number in VBA

[6String]

Hello:

I'm looking to see is if there is a way to modify this code to format a phone number as (999) 999-9999. Right now it formats phone numbers as 999-999-9999.

Thank you for your help!

Sub FormatPhoneNumber() 
     'Purpose: Formats a telephone number as 999-999-9999.
     'In cases where more than one phone number is enter in
     'a cell only the first number is returned. Extensions
     'are not formatted and are truncated.
     'Developed specifically for use in the spreadsheet
     'DataCollectionForm.xlsm where phone and fax number
     'are in the columns AB and AC. Conditional execution
     'only allows processing in those cells.
     'Tested against the following formats:
     '   (999)999-9999
     '   999 999 9999
     '   9999999999
     '   (999)999-9999 Ext 165
     '   (999)999-9999 OR (999)999-9999
     'Author: Marvin R. Reinhart
     'Date Created: 06/11/2007
     'Change History:
     '
    Dim sRawNumber As String 'Phone number as it was originally typed in the cell
    Dim sJustNumber As String 'Phone number with all non-numerics stripped out
    Dim sPhoneNumber As String 'Phone number formatted as 999-999-9999
    Dim iLen As Integer 'Len of value originally typed in the cell
    Dim iCtr As Integer 'Counter for processing loops
    Dim sActiveColumn As String 'Identifies the column the cell is in when the macro was executed
     
     'Determine the active column containing the cell when the macro was executed
    sActiveColumn = Mid$(Application.ActiveWindow.ActiveCell.Address, 2, InStr(2, Application.ActiveWindow.ActiveCell.Address, "$") - 2) 
     
     'If the macro was not executed in column AB or AC then do not attempt to format the value
    If sActiveColumn <> "AB" And sActiveColumn <> "AC" Then 
        Exit Sub 'End here
    End If 
     
     'Get the current data entered in the active cell
    sRawNumber = Application.ActiveWindow.ActiveCell.Value 
     
     'Get the length of the entry and use to control looping
    iLen = Len(Trim(sRawNumber)) 
     
     'Strip out all non-numeric characters
    For iCtr = 1 To iLen 
        If IsNumeric(Mid(sRawNumber, iCtr, 1)) Then 
            sJustNumber = sJustNumber & Mid(sRawNumber, iCtr, 1) 
        End If 
    Next iCtr 
     
     'If there are less than 10 digits then issue a warning to the user
     'that they should manually edit this entry because it does not appear
     'to be a telephone number with full area code.
    If Len(Trim(sJustNumber)) < 10 Then 
        MsgBox "The value in this cell does not appear to be " & _ 
        "a full valid phone number that includes the Area Code. " & _ 
        Chr(13) & "Please edit manually.", vbApplicationModal + vbInformation + vbOKOnly, "Manual Editing Required" 
        Exit Sub 'Exit without changing cell value
    End If 
     
     'Format as 999-999-9999
    For iCtr = 1 To Len(Trim(sJustNumber)) 
         'A dash is placed in the 4th and 7th positions otherwise just append the numeric charater
        If iCtr = 4 Or iCtr = 7 Then 
            sPhoneNumber = sPhoneNumber & "-" & Mid(sJustNumber, iCtr, 1) 
        Else 
            sPhoneNumber = sPhoneNumber & Mid(sJustNumber, iCtr, 1) 
        End If 
    Next 
     
     'Set the value of the cell from where the macro was executed to the
     'first 12 positions of the formatted phone number.
    Application.ActiveWindow.ActiveCell.Value = Left$(sPhoneNumber, 12) 
End Sub 

[goin4boge]

try adding htis as your last line:

Selection.NumberFormat = "[<=9999999]###-####;(###) ###-####" 

also, you need to wrap you code. put [ c o d e ] (no spaces) at the beginning of your code and [ / c o d e ] (no spaces) at the end of your code.

[6String]

I tried as suggested and still came up with the 999-999-9999.

 
 'Format as 999-999-9999
For iCtr = 1 To Len(Trim(sJustNumber)) 
     'A dash is placed in the 4th and 7th positions otherwise just append the numeric charater
    If iCtr = 4 Or iCtr = 7 Then 
         
        sPhoneNumber = sPhoneNumber & "-" & Mid(sJustNumber, iCtr, 1) 
        Selection.NumberFormat = "[<=9999999]###-####;(###) ###-####" 
    Else 
        sPhoneNumber = sPhoneNumber & Mid(sJustNumber, iCtr, 1) 
        Selection.NumberFormat = "[<=9999999]###-####;(###) ###-####" 
    End If 
Next 
 
 'Set the value of the cell from where the macro was executed to the
 'first 12 positions of the formatted phone number.
Application.ActiveWindow.ActiveCell.Value = Left$(sPhoneNumber, 12) 

[goin4boge]

I am sorry, i didn't make that clear, try putting it right after this line:

Application.ActiveWindow.ActiveCell.Value = Left$(sPhoneNumber, 12) 

[6String]

Hello:

That is where I placed it in the beginning.

[goin4boge]

could you attach a file to look at?