none
Format Phone Number in VBA

    Question

  • I have this code that formats any cell in columns AB or AC to a phone number as 999-999-9999.  Is there a way that this formula can modify it to format the cell 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

        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.
       
        ' Use this if you want to format to 999-999-9999
        Application.ActiveWindow.ActiveCell.Value = Left$(sPhoneNumber, 12)
          
    End Sub

    Thursday, November 15, 2012 1:00 PM

Answers

  • Try this: copy the code below, right-click the sheet tab, select "View Code" and paste the code into the window that appears. Format columns AB and AC as text to allow entry of numbers that are 20 characters long (two phone numbers), and then type the numbers into those columns. You will not need to use the command button - the change event will fire anytime you enter a number into a single cell in those columns.

    Bernie

    Private Sub Worksheet_Change(ByVal Target As Range)
    'Purpose: Formats a telephone number as (999) 999-9999.
    'Applies to columns AB and AC.
    'Will return the following depending on entry:
    '   (999) 999-9999
    '   (999) 999-9999 Ext 165
    '   (999) 999-9999 OR (999) 999-9999

        Dim sJustNumber As String   'Phone number with all non-numerics stripped out
        Dim sPhoneNumber As String  'Phone number formatted
        Dim iCtr As Integer         'Counter for processing loops

        If Intersect(Target, Range("AB:AC")) Is Nothing Then Exit Sub
        If Target.Cells.Count > 1 Then Exit Sub

        Application.EnableEvents = False

        'Strip out all non-numeric characters
        For iCtr = 1 To Len(Target.Value)
            If IsNumeric(Mid(Target.Value, iCtr, 1)) Then
                sJustNumber = sJustNumber & Mid(Target.Value, 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"
            GoTo Finish    'Exit without changing cell value
        End If

        'Format as (999)-999-9999
        sPhoneNumber = "(" & Left(sJustNumber, 3) & ") " & _
        Mid(sJustNumber, 4, 3) & "-" & Mid(sJustNumber, 7, 4)

        'Format the second number
        If Len(sJustNumber) = 20 Then
            sPhoneNumber = sPhoneNumber & " OR (" & Mid(sJustNumber, 11, 3) & ") " _
            & Mid(sJustNumber, 14, 3) & "-" & Mid(sJustNumber, 17, 4)
        End If
       
        'Format the extension
        If Len(sJustNumber) > 10 And Len(sJustNumber) < 20 Then
            sPhoneNumber = sPhoneNumber & " Ext " & Mid(sJustNumber, 11, Len(sJustNumber))
        End If

        Target.Value = sPhoneNumber
    Finish:
        Application.EnableEvents = True

    End Sub


    Thursday, November 15, 2012 4:24 PM

All replies

  • Why not just format AB:AC as Special / Phone Number?  That shows xxxyyyzzzz as (xxx) yyy-zzzz...
    Thursday, November 15, 2012 2:13 PM
  • I can do that, but I get information where occassionally I end up cutting & pasting extra information such as  phone extensions or other info like (xxx) yyy-zzzz/zzzz away from the cell.  Afterwards I have to mannually type the information the way I need it.  For some reason the cells don't retain the original format.  It uses the xxx-yyy-zzzz format instead of the parenthesis.  That's why I like to use the button command to fix the format for me.

    Thank you!

    Thursday, November 15, 2012 2:29 PM
  • Try this: copy the code below, right-click the sheet tab, select "View Code" and paste the code into the window that appears. Format columns AB and AC as text to allow entry of numbers that are 20 characters long (two phone numbers), and then type the numbers into those columns. You will not need to use the command button - the change event will fire anytime you enter a number into a single cell in those columns.

    Bernie

    Private Sub Worksheet_Change(ByVal Target As Range)
    'Purpose: Formats a telephone number as (999) 999-9999.
    'Applies to columns AB and AC.
    'Will return the following depending on entry:
    '   (999) 999-9999
    '   (999) 999-9999 Ext 165
    '   (999) 999-9999 OR (999) 999-9999

        Dim sJustNumber As String   'Phone number with all non-numerics stripped out
        Dim sPhoneNumber As String  'Phone number formatted
        Dim iCtr As Integer         'Counter for processing loops

        If Intersect(Target, Range("AB:AC")) Is Nothing Then Exit Sub
        If Target.Cells.Count > 1 Then Exit Sub

        Application.EnableEvents = False

        'Strip out all non-numeric characters
        For iCtr = 1 To Len(Target.Value)
            If IsNumeric(Mid(Target.Value, iCtr, 1)) Then
                sJustNumber = sJustNumber & Mid(Target.Value, 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"
            GoTo Finish    'Exit without changing cell value
        End If

        'Format as (999)-999-9999
        sPhoneNumber = "(" & Left(sJustNumber, 3) & ") " & _
        Mid(sJustNumber, 4, 3) & "-" & Mid(sJustNumber, 7, 4)

        'Format the second number
        If Len(sJustNumber) = 20 Then
            sPhoneNumber = sPhoneNumber & " OR (" & Mid(sJustNumber, 11, 3) & ") " _
            & Mid(sJustNumber, 14, 3) & "-" & Mid(sJustNumber, 17, 4)
        End If
       
        'Format the extension
        If Len(sJustNumber) > 10 And Len(sJustNumber) < 20 Then
            sPhoneNumber = sPhoneNumber & " Ext " & Mid(sJustNumber, 11, Len(sJustNumber))
        End If

        Target.Value = sPhoneNumber
    Finish:
        Application.EnableEvents = True

    End Sub


    Thursday, November 15, 2012 4:24 PM