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!
'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 Ext 165
' (999)999-9999 OR (999)999-9999
'Author: Marvin R. Reinhart
'Date Created: 06/11/2007
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
'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)
'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
'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)
sPhoneNumber = sPhoneNumber & Mid(sJustNumber, iCtr, 1)
'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)