Phone Number Formatting

[LeggoDave]

Hi everyone! I'm currently creating a VBA that formats phone number. All numbers must follow a standard format.
The scenario goes like this:
In the user's selection, or highlighted part/selected part, all phone number formats will be "three numbers" "-" "three numbers" "-" "four numbers".
*However this 'format' should only apply to US phone numbers, or telephone numbers that starts with +1
The VBA code should also be able to translate letters into numbers(phone letters) such as:
ABC = 2, DEF = 3, GHI = 4, JKL = 5, MNO = 6, PQRS = 7, TUV = 8, WXYZ = 9
For example, in a selection,
+1 (900) 800 8792
9118992343
281.928.9032
800 500 100
(+1) (839) 737 7289
ABC-DEF-ABC
900-900-9000
900-AAA-8ABE


Must be translated into the same location,
900-800-8792
911-899-2343
281-928-9032
800-500-100
839-737-7289
222-333-222
900-900-9000
900-222-8223


The code should be dynamic though. As you can see in the examples, letters are translated into numbers. All special characters are omitted, and the area code is removed. I'm still learning so I hope anyone would like to help me with this one. Thanks in advance!

 

[Rick Rothstein]

Give this macro a try (change the highlighted start cell and column designations as needed)...

[table="width: 500"]
[tr]
	[td]Sub PhoneNumber()
  Dim R As Long, X As Long, Data As Variant
  Data = Range("[B][COLOR="#FF0000"]A1[/COLOR][/B]", Cells(Rows.Count, "[B][COLOR="#FF0000"]A[/COLOR][/B]").End(xlUp))
  For R = 1 To UBound(Data)
    Data(R, 1) = UCase(Data(R, 1))
    For X = 1 To Len(Data(R, 1))
      If Mid(Data(R, 1), X, 1) Like "*[!0-9A-Z]*" Then Mid(Data(R, 1), X) = " "
    Next
    Data(R, 1) = Right(Replace(Data(R, 1), " ", ""), 10)
    For X = 1 To Len(Data(R, 1))
      If Mid(Data(R, 1), X, 1) Like "[A-Z]" Then Mid(Data(R, 1), X) = 2 + Int((InStr("ABC DEF GHI JKL MNO PQRSTUV WXYZ", Mid(Data(R, 1), X, 1)) - 1) / 4)
    Next
    Data(R, 1) = Format(Data(R, 1), "000-000-0000")
  Next
  Range("[B][COLOR="#FF0000"]A1[/COLOR][/B]").Resize(UBound(Data)) = Data
End Sub[/td]
[/tr]
[/table]

 

[VBA Geek]

Give this macro a try (change the highlighted start cell and column designations as needed)...

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub PhoneNumber()
  Dim R As Long, X As Long, Data As Variant
  Data = Range("[B][COLOR=#FF0000]A1[/COLOR][/B]", Cells(Rows.Count, "[B][COLOR=#FF0000]A[/COLOR][/B]").End(xlUp))
  For R = 1 To UBound(Data)
    Data(R, 1) = UCase(Data(R, 1))
    For X = 1 To Len(Data(R, 1))
      If Mid(Data(R, 1), X, 1) Like "*[!0-9A-Z]*" Then Mid(Data(R, 1), X) = " "
    Next
    Data(R, 1) = Right(Replace(Data(R, 1), " ", ""), 10)
    For X = 1 To Len(Data(R, 1))
      If Mid(Data(R, 1), X, 1) Like "[A-Z]" Then Mid(Data(R, 1), X) = 2 + Int((InStr("ABC DEF GHI JKL MNO PQRSTUV WXYZ", Mid(Data(R, 1), X, 1)) - 1) / 4)
    Next
    Data(R, 1) = Format(Data(R, 1), "000-000-0000")
  Next
  Range("[B][COLOR=#FF0000]A1[/COLOR][/B]").Resize(UBound(Data)) = Data
End Sub
[/TD]
[/TR]
</tbody>[/TABLE]

Hi Rick, you may want to check when the length of Data(R,1) is 9 and not 10, 000-000-0000 (last zero to go)

 

[LeggoDave]

Hi @Rick thank you for your response. However, Is there a way I could change the Range("A1") according to the selection of the user?

 

[LeggoDave]

And I tried it applying to cells with less than 10 numbers. It auto formatted and added 0's. Could it be possible for those numbers not to be formatted, but highlighted with a color instead? I hope you're still with me on this one

 

[Rick Rothstein]

And I tried it applying to cells with less than 10 numbers. It auto formatted and added 0's. Could it be possible for those numbers not to be formatted, but highlighted with a color instead? I hope you're still with me on this one

And I tried it applying to cells with less than 10 numbers. It auto formatted and added 0's. Could it be possible for those numbers not to be formatted, but highlighted with a color instead? I hope you're still with me on this one

Assuming the selection will be contiguous cells all within the same column...

[table="width: 500"]
[tr]
	[td]Sub PhoneNumber()
  Dim R As Long, X As Long, Original As String, Data As Variant
  Data = Selection.Value
  For R = 1 To UBound(Data)
    Original = Data(R, 1)
    Data(R, 1) = UCase(Data(R, 1))
    For X = 1 To Len(Data(R, 1))
      If Mid(Data(R, 1), X, 1) Like "*[!0-9A-Z]*" Then Mid(Data(R, 1), X) = " "
    Next
    Data(R, 1) = Right(Replace(Data(R, 1), " ", ""), 10)
    If Len(Data(R, 1)) = 10 Then
      For X = 1 To Len(Data(R, 1))
        If Mid(Data(R, 1), X, 1) Like "[A-Z]" Then Mid(Data(R, 1), X) = 2 + Int((InStr("ABC DEF GHI JKL MNO PQRSTUV WXYZ", Mid(Data(R, 1), X, 1)) - 1) / 4)
      Next
      Data(R, 1) = Format(Data(R, 1), "000-000-0000")
    Else
      Data(R, 1) = Original
      Selection(1).Offset(R - 1).Interior.Color = vbYellow
    End If
  Next
  Selection.Resize(UBound(Data)) = Data
End Sub[/td]
[/tr]
[/table]

 

[LeggoDave]

Thank you very much, Rick! I appreciate everything! I only have few things to ask:

1.) What does this code do?
2.) What happens at this equation?
3.) What happens to the values at this part?
4.) Which part of the code can I change so that I may apply the code to a single selection? (Currently, if the code is applied only to a single cell, it does not run/apply)
5.) Why does it only run on a single column? How can I change the selection according to whatevers the selection of the user? (e.g. different cells from different, other columns)
6.) What are the exceptions of this code?

Rick, thank you very much. I hope you still have the willingness to attend to my questions! You're a blessing!

 

[LeggoDave]

*Had to re-post ehem. I'm sorry*

1.) What does this code do?
Data(R, 1) = Right(Replace(Data(R, 1), " ", ""), 10)

2.) What happens at this equation?
If Mid(Data(R, 1), X, 1) Like "[A-Z]" Then Mid(Data(R, 1), X) = 2 + Int((InStr("ABC DEF GHI JKL MNO PQRSTUV WXYZ", Mid(Data(R, 1), X, 1)) - 1) / 4)

3.) What happens to the values at this part?
Data(R, 1) = Format(Data(R, 1), "000-000-0000")

4.) Which part of the code can I change so that I may apply the code to a single selection? (Currently, if the code is applied only to a single cell, it does not run/apply)
5.) Why does it only run on a single column? How can I change the selection according to whatevers the selection of the user? (e.g. different cells from different, other columns)
6.) What are the exceptions of this code?

Rick, thank you very much. I hope you still have the willingness to attend to my questions! You're a blessing!

 

[Rick Rothstein]

*Had to re-post ehem. I'm sorry*

1.) What does this code do?
Data(R, 1) = Right(Replace(Data(R, 1), " ", ""), 10)
The loop above it replaced any character that was not a digit or a letter with a blank space... this line of code removes any and all spaces.

2.) What happens at this equation?
If Mid(Data(R, 1), X, 1) Like "[A-Z]" Then Mid(Data(R, 1), X) = 2 + Int((InStr("ABC DEF GHI JKL MNO PQRSTUV WXYZ", Mid(Data(R, 1), X, 1)) - 1) / 4)
The If..Then test looks at a single character at position X and sees if it is a letter... if so, it calculates its position in that long text string and does a somewhat simple math operation to find which letter on a phone's number pad it corresponds to.

3.) What happens to the values at this part?
Data(R, 1) = Format(Data(R, 1), "000-000-0000")
At this point in the code, Data(R,1) contains 10 digits... Format (which is sort of VBA's equivalent to Excel's TEXT function) places dashes between the digits at the position shown in the text string of zeros.

4.) Which part of the code can I change so that I may apply the code to a single selection? (Currently, if the code is applied only to a single cell, it does not run/apply)
The code needs to be rewritten slightly to do this... see the revised code below.

5.) Why does it only run on a single column? How can I change the selection according to whatevers the selection of the user? (e.g. different cells from different, other columns)
The code needs to be rewritten slightly to be able to do this... see the revised code below.

6.) What are the exceptions of this code?
I am not sure there are any.

REVISED CODE (works on non-contiguous selections and single cells)

[table="width: 500"]
[tr]
	[td]Sub PhoneNumber()
  Dim X As Long, Original As String, CellText As String, Cell As Range
  For Each Cell In Selection
    Original = Cell.Value
    CellText = UCase(Cell.Value)
    For X = 1 To Len(CellText)
      If Mid(CellText, X, 1) Like "*[!0-9A-Z]*" Then Mid(CellText, X) = " "
    Next
    CellText = Right(Replace(CellText, " ", ""), 10)
    If Len(CellText) = 10 Then
      For X = 1 To Len(CellText)
        If Mid(CellText, X, 1) Like "[A-Z]" Then Mid(CellText, X) = 2 + Int((InStr("ABC DEF GHI JKL MNO PQRSTUV WXYZ", Mid(CellText, X, 1)) - 1) / 4)
      Next
      Cell.Value = Format(CellText, "000-000-0000")
    Else
      Cell.Value = Original
      Cell.Interior.Color = vbYellow
    End If
  Next
End Sub[/td]
[/tr]
[/table]

 

[LeggoDave]

Rick!!! Thank you very much! I will try doing my files with your code and if ever I encounter some issues or some part that I don't understand, I hope you'll still be in touch! Thank you soooooo much!