Allowing only one phone number input format.

[FrancisM]

There are multiple people using this worksheet to, and they all have their own way of inputting phone numbers. I am trying to allow only one type of formatting. Here is the code. [Sub PhoneNumberFormat()
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 And Len(Trim(Target.Value)) > 0 Then
Target.Value = onlyNumbers(Target.Value)
Target.NumberFormat = "(000) 000-0000"
End If
End Sub

Private Function onlyNumbers(myVal As Variant) As Variant
Dim l As Integer
For l = 1 To Len(myVal)
If IsNumeric(Mid(myVal, l, 1)) Then onlyNumbers = onlyNumbers & Mid(myVal, l, 1)
Next l
End Function]
I have attached the file because I am having some hang up issues.
Thanks for your assistance.

[NoSparks]

Try this on the sheet module only, remove the standard module you have

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
' the cell being monitored
    If Target.Address <> "$I$30" Or Target.Value = "" Then Exit Sub
' unprotect sheet
    ActiveSheet.Unprotect
' prevent this procedure from calling itself
    Application.EnableEvents = False
' change what's in the cell
    Target.Value = onlyNumbers(Target.Value)
    Target.NumberFormat = "(000) 000-0000"
' re-enable events
    Application.EnableEvents = True
' re-protect sheet
    ActiveSheet.Protect
End Sub


Private Function onlyNumbers(myVal As Variant) As Variant
    Dim i   As Integer
    For i = 1 To Len(myVal)
        If IsNumeric(Mid(myVal, i, 1)) Then onlyNumbers = onlyNumbers & Mid(myVal, i, 1)
    Next i
End Function



[FrancisM]

NoSparks . Thanks it work perfectly.

[NoSparks]

You're welcome, glad I could help and thanks for reporting back.

[FrancisM]

NoSparks. I just learned that I I click on row 28 :Address., I get a run time error 13 type mismatch.
below is the code & it hangs on If Target.Column = 9 And Len(Trim(Target.Value)) > 0 Then

[Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 9 And Len(Trim(Target.Value)) > 0 Then
Target.Value = onlyNumbers(Target.Value)
Target.NumberFormat = "(000) 000-0000"
End If
End Sub]
Any ideas?
if you use the sample file I sent earlier it happens there also.

[FrancisM]

Code: Select all

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Column = 9 And Len(Trim(Target.Value)) > 0 Then
 Target.Value = onlyNumbers(Target.Value)
 Target.NumberFormat = "(000) 000-0000"
End If
End Sub

[NoSparks]

Any ideas?

Yup, MERGED CELLS.

[FrancisM]

How stupid of me. You are correct. Merged cells. Thank You!!!!!

[FrancisM]

Question. I tried to use the same formula for social security numbers changing field $I$30 to $H$21, and (000) 000-0000 to 000-00-0000. When I run it there is no change. Any ideas.

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
' the cell being monitored
    If Target.Address <> "$H$21" Or Target.Value = "" Then Exit Sub
' unprotect sheet
    ActiveSheet.Unprotect
' prevent this procedure from calling itself
    Application.EnableEvents = False
' change what's in the cell
    Target.Value = onlyNumbers(Target.Value)
    Target.NumberFormat = "000-000-0000"
' re-enable events
    Application.EnableEvents = True
' re-protect sheet
    ActiveSheet.Protect
End Sub

[NoSparks]

Your text indicates the format as 000-00-0000
the code you've posted has it as 000-000-0000
you'll need to adjust if necessary.

Code: Select all

Private Sub Worksheet_Change(ByVal Target As Range)
' the cells being monitor
    If Target.Address <> "$I$30" And Target.Address <> "$H$21" Then Exit Sub
    If Target.Value = "" Then Exit Sub
' unprotect sheet
    ActiveSheet.Unprotect
' prevent this procedure from calling itself
    Application.EnableEvents = False
' change what's in cell if I30
    If Target.Address = "$I$30" Then
        Target.Value = onlyNumbers(Target.Value)
        Target.NumberFormat = "(000) 000-0000"
    End If
'change what's in cell if H21
    If Target.Address = "$H$21" Then
        Target.Value = onlyNumbers(Target.Value)
        Target.NumberFormat = "000-000-0000"
    End If
' re-enable events
    Application.EnableEvents = True
' re-protect sheet
    ActiveSheet.Protect
End Sub