Greetings,

I need to remove non numeric characters from a text string in an
automatic input into targeted cells.

I am loading these cells with telephone numbers and extensions. They
have different formats and I want to normalized them to a single
format (one for the phone and 1 for the extension if there is one)

The format I am looking for is:

Phone: (###) ###-####
Extension: Ext. ######

There are a couple of problems with these formats.
1) Phone numbers without area code give me () ###-####.
2) The extension number format only kicks in if there are only
numbers.

This is the code that I am running in the Worksheet_Change() event:
__________________________________________________ _________________
Private Sub Worksheet_Change(ByVal Target As Range)
Dim bFlag As Boolean
Dim S1 As String, s2 As String

S1 = Target.Value
If Target.Count 1 Then Exit Sub
If Target.Row = 1 Then Exit Sub
If Len(S1) = 0 Then Exit Sub
Select Case Target.Column
Case 19, 21, 37, 39, 41, 43, _
45, 47, 49, 51, 53, 55 'Telephone format
If Not Len(S1) = 10 Then Exit Sub
s2 = Replace(S1, "(", "")
s2 = Replace(s2, ")", "")
s2 = Replace(s2, ".", "")
s2 = Replace(s2, " ", "")
s2 = Replace(s2, "-", "")
s2 = Replace(s2, "_", "")
s2 = Format((S1), "(###) ###-####")
bFlag = S1 < s2
If bFlag Then
On Error GoTo EndIt
Application.EnableEvents = False
Target.Value = s2
End If
Case 20, 22, 38, 40, 42, 44, _
46, 48, 50, 52, 54, 56 'Telephone extension format
s2 = Replace(LCase(S1), "ext", "")
s2 = Replace(LCase(S1), "x", "")
s2 = Replace(S1, "(", "")
s2 = Replace(s2, ")", "")
s2 = Replace(s2, ".", "")
s2 = Replace(s2, " ", "")
s2 = Replace(s2, "-", "")
s2 = Replace(s2, "_", "")
s2 = Format((S1), "Ext #####")
bFlag = S1 < s2
If bFlag Then
On Error GoTo EndIt
Application.EnableEvents = False
Target.Value = s2
End If
Case Else
Exit Sub
End Select

EndIt:
If bFlag Then Application.EnableEvents = True

End Sub
__________________________________________________ _________________

Is there anyway to fix these two problems?

Any help will be appreciated.

Thanks for looking at my challenge.

-Minitman

Give this code a try...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim X As Long
Dim S As String
Dim bFlag As Boolean

S = Target.Value
If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Then Exit Sub
For X = 1 To Len(S)
If Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 19, 21, 37, 39, 41, 43, 45, 47, 49, 51, 53, 55 'Telephone format
If Len(S) = 7 Then
S = Format(S, "000-0000")
ElseIf Len(S) = 10 Then
S = Format(S, "(000) 000-0000")
Else
Exit Sub
End If
Case 20, 22, 38, 40, 42, 44, 46, 48, 50, 52, 54, 56 'Extension format
S = Format(S, "Ext " & String(Len(S), "0"))
End Select

On Error GoTo EndIt
Application.EnableEvents = False
Target.Value = S
EndIt:
Application.EnableEvents = True

End Sub


Rick


"Minitman" wrote in message
...
Greetings,

I need to remove non numeric characters from a text string in an
automatic input into targeted cells.

I am loading these cells with telephone numbers and extensions. They
have different formats and I want to normalized them to a single
format (one for the phone and 1 for the extension if there is one)

The format I am looking for is:

Phone: (###) ###-####
Extension: Ext. ######

There are a couple of problems with these formats.
1) Phone numbers without area code give me () ###-####.
2) The extension number format only kicks in if there are only
numbers.

This is the code that I am running in the Worksheet_Change() event:
__________________________________________________ _________________
Private Sub Worksheet_Change(ByVal Target As Range)
Dim bFlag As Boolean
Dim S1 As String, s2 As String

S1 = Target.Value
If Target.Count 1 Then Exit Sub
If Target.Row = 1 Then Exit Sub
If Len(S1) = 0 Then Exit Sub
Select Case Target.Column
Case 19, 21, 37, 39, 41, 43, _
45, 47, 49, 51, 53, 55 'Telephone format
If Not Len(S1) = 10 Then Exit Sub
s2 = Replace(S1, "(", "")
s2 = Replace(s2, ")", "")
s2 = Replace(s2, ".", "")
s2 = Replace(s2, " ", "")
s2 = Replace(s2, "-", "")
s2 = Replace(s2, "_", "")
s2 = Format((S1), "(###) ###-####")
bFlag = S1 < s2
If bFlag Then
On Error GoTo EndIt
Application.EnableEvents = False
Target.Value = s2
End If
Case 20, 22, 38, 40, 42, 44, _
46, 48, 50, 52, 54, 56 'Telephone extension format
s2 = Replace(LCase(S1), "ext", "")
s2 = Replace(LCase(S1), "x", "")
s2 = Replace(S1, "(", "")
s2 = Replace(s2, ")", "")
s2 = Replace(s2, ".", "")
s2 = Replace(s2, " ", "")
s2 = Replace(s2, "-", "")
s2 = Replace(s2, "_", "")
s2 = Format((S1), "Ext #####")
bFlag = S1 < s2
If bFlag Then
On Error GoTo EndIt
Application.EnableEvents = False
Target.Value = s2
End If
Case Else
Exit Sub
End Select

EndIt:
If bFlag Then Application.EnableEvents = True

End Sub
__________________________________________________ _________________

Is there anyway to fix these two problems?

Any help will be appreciated.

Thanks for looking at my challenge.

-Minitman

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Then Exit Sub

I guess of efficiency sake, it might be a good idea to exit the sub if the
target column does not fall in range. To that end, replace the above line
from my posted code with this one...

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or Not Intersect( _
Target, Union(Range("19:22"), Range("37:56"))) Is Nothing Then Exit Sub

Rick


"Rick Rothstein (MVP - VB)" wrote in
message ...
Give this code a try...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim X As Long
Dim S As String
Dim bFlag As Boolean

S = Target.Value
If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Then Exit Sub
For X = 1 To Len(S)
If Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 19, 21, 37, 39, 41, 43, 45, 47, 49, 51, 53, 55 'Telephone format
If Len(S) = 7 Then
S = Format(S, "000-0000")
ElseIf Len(S) = 10 Then
S = Format(S, "(000) 000-0000")
Else
Exit Sub
End If
Case 20, 22, 38, 40, 42, 44, 46, 48, 50, 52, 54, 56 'Extension format
S = Format(S, "Ext " & String(Len(S), "0"))
End Select

On Error GoTo EndIt
Application.EnableEvents = False
Target.Value = S
EndIt:
Application.EnableEvents = True

End Sub


Rick


"Minitman" wrote in message
...
Greetings,

I need to remove non numeric characters from a text string in an
automatic input into targeted cells.

I am loading these cells with telephone numbers and extensions. They
have different formats and I want to normalized them to a single
format (one for the phone and 1 for the extension if there is one)

The format I am looking for is:

Phone: (###) ###-####
Extension: Ext. ######

There are a couple of problems with these formats.
1) Phone numbers without area code give me () ###-####.
2) The extension number format only kicks in if there are only
numbers.

This is the code that I am running in the Worksheet_Change() event:
__________________________________________________ _________________
Private Sub Worksheet_Change(ByVal Target As Range)
Dim bFlag As Boolean
Dim S1 As String, s2 As String

S1 = Target.Value
If Target.Count 1 Then Exit Sub
If Target.Row = 1 Then Exit Sub
If Len(S1) = 0 Then Exit Sub
Select Case Target.Column
Case 19, 21, 37, 39, 41, 43, _
45, 47, 49, 51, 53, 55 'Telephone format
If Not Len(S1) = 10 Then Exit Sub
s2 = Replace(S1, "(", "")
s2 = Replace(s2, ")", "")
s2 = Replace(s2, ".", "")
s2 = Replace(s2, " ", "")
s2 = Replace(s2, "-", "")
s2 = Replace(s2, "_", "")
s2 = Format((S1), "(###) ###-####")
bFlag = S1 < s2
If bFlag Then
On Error GoTo EndIt
Application.EnableEvents = False
Target.Value = s2
End If
Case 20, 22, 38, 40, 42, 44, _
46, 48, 50, 52, 54, 56 'Telephone extension format
s2 = Replace(LCase(S1), "ext", "")
s2 = Replace(LCase(S1), "x", "")
s2 = Replace(S1, "(", "")
s2 = Replace(s2, ")", "")
s2 = Replace(s2, ".", "")
s2 = Replace(s2, " ", "")
s2 = Replace(s2, "-", "")
s2 = Replace(s2, "_", "")
s2 = Format((S1), "Ext #####")
bFlag = S1 < s2
If bFlag Then
On Error GoTo EndIt
Application.EnableEvents = False
Target.Value = s2
End If
Case Else
Exit Sub
End Select

EndIt:
If bFlag Then Application.EnableEvents = True

End Sub
__________________________________________________ _________________

Is there anyway to fix these two problems?

Any help will be appreciated.

Thanks for looking at my challenge.

-Minitman

On Fri, 13 Jun 2008 00:46:06 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or Not Intersect( _
Target, Union(Range("19:22"), Range("37:56"))) Is Nothing Then Exit Sub

I don't understand this.

In particular:

.... Not Intersect( Target, Union(Range("19:22"), Range("37:56"))) Is Nothing
Then Exit Sub

in relation to the OP's setup.

Aren't you testing to see IF target does intersect with ROWS 19:22, 37:56
--ron

How did that Not operator keyword sneak in there? <g

Thanks for spotting that Ron... as stated above, the Not keyword should not
have been in there; the correct statement should have been...

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or Intersect(Target, _
Union(Range("19:22"), Range("37:56"))) Is Nothing Then Exit Sub

Rick


"Ron Rosenfeld" wrote in message
...
On Fri, 13 Jun 2008 00:46:06 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or Not Intersect( _
Target, Union(Range("19:22"), Range("37:56"))) Is Nothing Then Exit Sub

I don't understand this.

In particular:

... Not Intersect( Target, Union(Range("19:22"), Range("37:56"))) Is
Nothing
Then Exit Sub

in relation to the OP's setup.

Aren't you testing to see IF target does intersect with ROWS 19:22, 37:56
--ron

On Fri, 13 Jun 2008 23:34:03 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

How did that Not operator keyword sneak in there? <g

Thanks for spotting that Ron... as stated above, the Not keyword should not
have been in there; the correct statement should have been...

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or Intersect(Target, _
Union(Range("19:22"), Range("37:56"))) Is Nothing Then Exit Sub

Rick

Rick,

What about the referencing of rows and not columns? Did I miss something in
the OP?

--ron

Rick,

I was working on this too, but your code is so much cleaner. I was thinking
that instead of applying the format to the string, Steve could add it to the
cell, so that the cell contents are only the numbers, but they look
formatted. What do you think of this?:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim X As Long
Dim S As String
Dim bFlag As Boolean

On Error GoTo EndIt
Application.EnableEvents = False
S = Target.Value
If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or Not Intersect( _
Target, Union(Range("19:22"), Range("37:56"))) Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")
Target.Value = S

Select Case Target.Column
Case 19, 21, 37, 39, 41, 43, 45, 47, 49, 51, 53, 55 'Telephone format
Target.NumberFormat = "[<=9999999]###-####;(###) ###-####"
Case 20, 22, 38, 40, 42, 44, 46, 48, 50, 52, 54, 56 'Extension format
Target.NumberFormat = """Ext ""General"
End Select

EndIt:
Application.EnableEvents = True

End Sub

Doug



"Minitman" wrote in message
...
Greetings,

I need to remove non numeric characters from a text string in an
automatic input into targeted cells.

I am loading these cells with telephone numbers and extensions. They
have different formats and I want to normalized them to a single
format (one for the phone and 1 for the extension if there is one)

The format I am looking for is:

Phone: (###) ###-####
Extension: Ext. ######

There are a couple of problems with these formats.
1) Phone numbers without area code give me () ###-####.
2) The extension number format only kicks in if there are only
numbers.

This is the code that I am running in the Worksheet_Change() event:
__________________________________________________ _________________
Private Sub Worksheet_Change(ByVal Target As Range)
Dim bFlag As Boolean
Dim S1 As String, s2 As String

S1 = Target.Value
If Target.Count 1 Then Exit Sub
If Target.Row = 1 Then Exit Sub
If Len(S1) = 0 Then Exit Sub
Select Case Target.Column
Case 19, 21, 37, 39, 41, 43, _
45, 47, 49, 51, 53, 55 'Telephone format
If Not Len(S1) = 10 Then Exit Sub
s2 = Replace(S1, "(", "")
s2 = Replace(s2, ")", "")
s2 = Replace(s2, ".", "")
s2 = Replace(s2, " ", "")
s2 = Replace(s2, "-", "")
s2 = Replace(s2, "_", "")
s2 = Format((S1), "(###) ###-####")
bFlag = S1 < s2
If bFlag Then
On Error GoTo EndIt
Application.EnableEvents = False
Target.Value = s2
End If
Case 20, 22, 38, 40, 42, 44, _
46, 48, 50, 52, 54, 56 'Telephone extension format
s2 = Replace(LCase(S1), "ext", "")
s2 = Replace(LCase(S1), "x", "")
s2 = Replace(S1, "(", "")
s2 = Replace(s2, ")", "")
s2 = Replace(s2, ".", "")
s2 = Replace(s2, " ", "")
s2 = Replace(s2, "-", "")
s2 = Replace(s2, "_", "")
s2 = Format((S1), "Ext #####")
bFlag = S1 < s2
If bFlag Then
On Error GoTo EndIt
Application.EnableEvents = False
Target.Value = s2
End If
Case Else
Exit Sub
End Select

EndIt:
If bFlag Then Application.EnableEvents = True

End Sub
__________________________________________________ _________________

Is there anyway to fix these two problems?

Any help will be appreciated.

Thanks for looking at my challenge.

-Minitman

Ooops, I meant to reply to Rick's. Just to be clear this is his code with a
couple of changes I thought were interesting.

Doug

"Doug Glancy" wrote in message
...
Rick,

I was working on this too, but your code is so much cleaner. I was
thinking that instead of applying the format to the string, Steve could
add it to the cell, so that the cell contents are only the numbers, but
they look formatted. What do you think of this?:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim X As Long
Dim S As String
Dim bFlag As Boolean

On Error GoTo EndIt
Application.EnableEvents = False
S = Target.Value
If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or Not Intersect( _
Target, Union(Range("19:22"), Range("37:56"))) Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")
Target.Value = S

Select Case Target.Column
Case 19, 21, 37, 39, 41, 43, 45, 47, 49, 51, 53, 55 'Telephone format
Target.NumberFormat = "[<=9999999]###-####;(###) ###-####"
Case 20, 22, 38, 40, 42, 44, 46, 48, 50, 52, 54, 56 'Extension format
Target.NumberFormat = """Ext ""General"
End Select

EndIt:
Application.EnableEvents = True

End Sub

Doug



"Minitman" wrote in message
...
Greetings,

I need to remove non numeric characters from a text string in an
automatic input into targeted cells.

I am loading these cells with telephone numbers and extensions. They
have different formats and I want to normalized them to a single
format (one for the phone and 1 for the extension if there is one)

The format I am looking for is:

Phone: (###) ###-####
Extension: Ext. ######

There are a couple of problems with these formats.
1) Phone numbers without area code give me () ###-####.
2) The extension number format only kicks in if there are only
numbers.

This is the code that I am running in the Worksheet_Change() event:
__________________________________________________ _________________
Private Sub Worksheet_Change(ByVal Target As Range)
Dim bFlag As Boolean
Dim S1 As String, s2 As String

S1 = Target.Value
If Target.Count 1 Then Exit Sub
If Target.Row = 1 Then Exit Sub
If Len(S1) = 0 Then Exit Sub
Select Case Target.Column
Case 19, 21, 37, 39, 41, 43, _
45, 47, 49, 51, 53, 55 'Telephone format
If Not Len(S1) = 10 Then Exit Sub
s2 = Replace(S1, "(", "")
s2 = Replace(s2, ")", "")
s2 = Replace(s2, ".", "")
s2 = Replace(s2, " ", "")
s2 = Replace(s2, "-", "")
s2 = Replace(s2, "_", "")
s2 = Format((S1), "(###) ###-####")
bFlag = S1 < s2
If bFlag Then
On Error GoTo EndIt
Application.EnableEvents = False
Target.Value = s2
End If
Case 20, 22, 38, 40, 42, 44, _
46, 48, 50, 52, 54, 56 'Telephone extension format
s2 = Replace(LCase(S1), "ext", "")
s2 = Replace(LCase(S1), "x", "")
s2 = Replace(S1, "(", "")
s2 = Replace(s2, ")", "")
s2 = Replace(s2, ".", "")
s2 = Replace(s2, " ", "")
s2 = Replace(s2, "-", "")
s2 = Replace(s2, "_", "")
s2 = Format((S1), "Ext #####")
bFlag = S1 < s2
If bFlag Then
On Error GoTo EndIt
Application.EnableEvents = False
Target.Value = s2
End If
Case Else
Exit Sub
End Select

EndIt:
If bFlag Then Application.EnableEvents = True

End Sub
__________________________________________________ _________________

Is there anyway to fix these two problems?

Any help will be appreciated.

Thanks for looking at my challenge.

-Minitman

This is definitely an acceptable approach. I went with the "string format"
because that is what the OP was attempting to do; the cell format method you
proposed simply didn't cross my mind at the time. I'm glad you posted it
because now the OP has an alternative to consider.

Rick


"Doug Glancy" wrote in message
...
Rick,

I was working on this too, but your code is so much cleaner. I was
thinking that instead of applying the format to the string, Steve could
add it to the cell, so that the cell contents are only the numbers, but
they look formatted. What do you think of this?:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim X As Long
Dim S As String
Dim bFlag As Boolean

On Error GoTo EndIt
Application.EnableEvents = False
S = Target.Value
If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or Not Intersect( _
Target, Union(Range("19:22"), Range("37:56"))) Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")
Target.Value = S

Select Case Target.Column
Case 19, 21, 37, 39, 41, 43, 45, 47, 49, 51, 53, 55 'Telephone format
Target.NumberFormat = "[<=9999999]###-####;(###) ###-####"
Case 20, 22, 38, 40, 42, 44, 46, 48, 50, 52, 54, 56 'Extension format
Target.NumberFormat = """Ext ""General"
End Select

EndIt:
Application.EnableEvents = True

End Sub

Doug



"Minitman" wrote in message
...
Greetings,

I need to remove non numeric characters from a text string in an
automatic input into targeted cells.

I am loading these cells with telephone numbers and extensions. They
have different formats and I want to normalized them to a single
format (one for the phone and 1 for the extension if there is one)

The format I am looking for is:

Phone: (###) ###-####
Extension: Ext. ######

There are a couple of problems with these formats.
1) Phone numbers without area code give me () ###-####.
2) The extension number format only kicks in if there are only
numbers.

This is the code that I am running in the Worksheet_Change() event:
__________________________________________________ _________________
Private Sub Worksheet_Change(ByVal Target As Range)
Dim bFlag As Boolean
Dim S1 As String, s2 As String

S1 = Target.Value
If Target.Count 1 Then Exit Sub
If Target.Row = 1 Then Exit Sub
If Len(S1) = 0 Then Exit Sub
Select Case Target.Column
Case 19, 21, 37, 39, 41, 43, _
45, 47, 49, 51, 53, 55 'Telephone format
If Not Len(S1) = 10 Then Exit Sub
s2 = Replace(S1, "(", "")
s2 = Replace(s2, ")", "")
s2 = Replace(s2, ".", "")
s2 = Replace(s2, " ", "")
s2 = Replace(s2, "-", "")
s2 = Replace(s2, "_", "")
s2 = Format((S1), "(###) ###-####")
bFlag = S1 < s2
If bFlag Then
On Error GoTo EndIt
Application.EnableEvents = False
Target.Value = s2
End If
Case 20, 22, 38, 40, 42, 44, _
46, 48, 50, 52, 54, 56 'Telephone extension format
s2 = Replace(LCase(S1), "ext", "")
s2 = Replace(LCase(S1), "x", "")
s2 = Replace(S1, "(", "")
s2 = Replace(s2, ")", "")
s2 = Replace(s2, ".", "")
s2 = Replace(s2, " ", "")
s2 = Replace(s2, "-", "")
s2 = Replace(s2, "_", "")
s2 = Format((S1), "Ext #####")
bFlag = S1 < s2
If bFlag Then
On Error GoTo EndIt
Application.EnableEvents = False
Target.Value = s2
End If
Case Else
Exit Sub
End Select

EndIt:
If bFlag Then Application.EnableEvents = True

End Sub
__________________________________________________ _________________

Is there anyway to fix these two problems?

Any help will be appreciated.

Thanks for looking at my challenge.

-Minitman

On Thu, 12 Jun 2008 22:49:47 -0500, Minitman
wrote:

I need to remove non numeric characters from a text string in an
automatic input into targeted cells.

I am loading these cells with telephone numbers and extensions. They
have different formats and I want to normalized them to a single
format (one for the phone and 1 for the extension if there is one)

The format I am looking for is:

Phone: (###) ###-####
Extension: Ext. ######

There are a couple of problems with these formats.
1) Phone numbers without area code give me () ###-####.
2) The extension number format only kicks in if there are only
numbers.

If you are just using US-centric numbers, you could add tests for valid phone
numbers and/or extensions in the relevant segments after removing the
non-numeric characters.

For example, a valid US phone number might have 7 digits or 10 digits and, if
there are 11 digits (e.g. 18001234567) you could remove the leading 1)

A valid extension might also have some minimum/maximum number of digits.

Try this:

===========================================
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rTel As Range, rExt As Range, c As Range
Dim re As Object

Set rTel = Union(Columns(19), Columns(21), Columns(37), Columns(39), _
Columns(41), Columns(43), Columns(45), Columns(47), _
Columns(49), Columns(51), Columns(53), Columns(55))

Set rExt = Union(Columns(20), Columns(22), Columns(38), Columns(42), _
Columns(44), Columns(46), Columns(48), Columns(50), _
Columns(52), Columns(54), Columns(56))

If Not Intersect(Target, Union(rTel, rExt)) Is Nothing Then
Application.EnableEvents = False
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = "\D+"
For Each c In Target
If Not Intersect(c, rTel) Is Nothing Then
c.Value = re.Replace(c.Value, "")
c.NumberFormat = "[<=9999999]###-####;(###) ###-####"
End If
If Not Intersect(c, rExt) Is Nothing Then
c.Value = re.Replace(c.Value, "")
c.NumberFormat = """Ext. ""General"
End If
Next c
Application.EnableEvents = True
End If
End Sub
=====================================
--ron

On Fri, 13 Jun 2008 07:36:03 -0400, Ron Rosenfeld
wrote:

I need to remove non numeric characters from a text string in an
automatic input into targeted cells.

I am loading these cells with telephone numbers and extensions. They
have different formats and I want to normalized them to a single
format (one for the phone and 1 for the extension if there is one)


It occurs to me that if you are importing these numbers from some other file,
it might be more efficient to first do the import, and then process the data.
--ron

Rick, Doug & Ron,

This is a very interesting discussion and you all have given very
interesting solutions. These are so in depth that I realized that I
should have included the first condition of this worksheet_Change
event, since I am not sure how to incorporate it into any of your
solutions. Here is the complete worksheet_Change event code for that
sheet:
__________________________________________________ __________

Private Sub Worksheet_Change(ByVal Target As Range)
Dim bFlag As Boolean
Dim S1 As String, s2 As String
S1 = Target.Value
If Target.Count 1 Then Exit Sub
If Target.Row = 1 Then Exit Sub
If Len(S1) = 0 Then Exit Sub
Select Case Target.Column
Case 24 'MapsCo Formatting
s2 = Replace(LCase(S1), "map", "")
s2 = Replace(s2, "<", "")
s2 = Replace(s2, "", "")
s2 = Replace(s2, " ", "")
s2 = Replace(s2, "-", "")
s2 = Replace(s2, "[", "")
s2 = Replace(s2, "]", "")
s2 = Replace(s2, "{", "")
s2 = Replace(s2, "}", "")
s2 = Format(s2, "!Map @@@@ \<@@-@@\")
bFlag = S1 < s2
If bFlag Then
On Error GoTo EndIt
Application.EnableEvents = False
Target.Value = s2
End If
Case 19, 21, 37, 39, 41, 43, _
45, 47, 49, 51, 53, 55 'Telephone format
If Not Len(S1) = 10 Then Exit Sub
s2 = Replace(S1, "(", "")
s2 = Replace(s2, ")", "")
s2 = Replace(s2, ".", "")
s2 = Replace(s2, " ", "")
s2 = Replace(s2, "-", "")
s2 = Replace(s2, "_", "")
s2 = Format((S1), "(###) ###-####")
bFlag = S1 < s2
If bFlag Then
On Error GoTo EndIt
Application.EnableEvents = False
Target.Value = s2
End If
Case 20, 22, 38, 40, 42, 44, _
46, 48, 50, 52, 54, 56 'Telephone extension format
s2 = Replace(LCase(S1), "ext", "")
s2 = Replace(LCase(S1), "x", "")
s2 = Replace(S1, "(", "")
s2 = Replace(s2, ")", "")
s2 = Replace(s2, ".", "")
s2 = Replace(s2, " ", "")
s2 = Replace(s2, "-", "")
s2 = Replace(s2, "_", "")
s2 = Format((S1), "Ext #####")
bFlag = S1 < s2
If bFlag Then
On Error GoTo EndIt
Application.EnableEvents = False
Target.Value = s2
End If
Case Else
Exit Sub
End Select
EndIt:
If bFlag Then Application.EnableEvents = True
End Sub
__________________________________________________ __________

I had left out the Case 24 (the formatting that Peter T came up with
using Rick's "voodoo" formatting trick back in Jul 10, 2007) since I
thought it would be a less cluttered post and that it should be a
simple matter to reintegrate it into the final code, silly me.

But I don't understand vbscript or what is actually happening! I'm a
little afraid to start modifying code I don't understand!

Are there any special tricks that I should be aware of when attempting
to utilize and or modify your suggestions?

As always, thank you all for your contributions and code.

-Minitman

On Fri, 13 Jun 2008 10:28:27 -0400, Ron Rosenfeld
wrote:

On Fri, 13 Jun 2008 07:36:03 -0400, Ron Rosenfeld
wrote:

I need to remove non numeric characters from a text string in an
automatic input into targeted cells.

I am loading these cells with telephone numbers and extensions. They
have different formats and I want to normalized them to a single
format (one for the phone and 1 for the extension if there is one)


It occurs to me that if you are importing these numbers from some other file,
it might be more efficient to first do the import, and then process the data.
--ron

On Fri, 13 Jun 2008 19:14:02 -0500, Minitman
wrote:

I had left out the Case 24 (the formatting that Peter T came up with
using Rick's "voodoo" formatting trick back in Jul 10, 2007) since I
thought it would be a less cluttered post and that it should be a
simple matter to reintegrate it into the final code, silly me.

But I don't understand vbscript or what is actually happening! I'm a
little afraid to start modifying code I don't understand!

Are there any special tricks that I should be aware of when attempting
to utilize and or modify your suggestions?

1. Rick's routine returns your result as a text string. Mine and Doug's return
a number formatted as a telephone number or extension. They would both appear
the same in the cell -- but Text and Numbers will behave differently in
formulas.

2. You would have to add the Column 24 to my list of both an acceptable Target
and also for a different format. Could you give an example of what it would
look like? And does the data in Column 24 also require removal of all
non-digits?

If so, mine is easily modified to something like:


================================
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rTel As Range, rExt As Range, c As Range
Dim col As Object
Dim rMapsCo As Range
Dim re As Object

Set rTel = Union(Columns(19), Columns(21), Columns(37), Columns(39), _
Columns(41), Columns(43), Columns(45), Columns(47), _
Columns(49), Columns(51), Columns(53), Columns(55))

Set rExt = Union(Columns(20), Columns(22), Columns(38), Columns(42), _
Columns(44), Columns(46), Columns(48), Columns(50), _
Columns(52), Columns(54), Columns(56))

Set rMapsCo = Columns(24)

If Not Intersect(Target, Union(rTel, rExt, rMapsCo)) Is Nothing Then
Application.EnableEvents = False
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = "\D+"
For Each c In Target
If Not Intersect(c, rTel) Is Nothing _
And c.Row < 1 Then
c.Value = re.Replace(c.Value, "")
c.NumberFormat = "[<=9999999]###-####;(###) ###-####"
End If
If Not Intersect(c, rExt) Is Nothing _
And c.Row < 1 Then
c.Value = re.Replace(c.Value, "")
c.NumberFormat = """Ext. ""0"
End If
If Not Intersect(c, rMapsCo) Is Nothing _
And c.Row < 1 Then
c.Value = re.Replace(c.Value, "")
c.NumberFormat = """!Map ""0000 ""\<""00-00""\"""
End If
Next c
Application.EnableEvents = True
End If
End Sub
=================================

IF you prefer a text string output, then you can change the lines that output
the values, as in below:

============================
....
For Each c In Target
If Not Intersect(c, rTel) Is Nothing _
And c.Row < 1 Then
c.Value = Application.WorksheetFunction.Text _
(re.Replace(c.Value, ""), "[<=9999999]###-####;(###) ###-####")
End If
If Not Intersect(c, rExt) Is Nothing _
And c.Row < 1 Then
c.Value = Application.WorksheetFunction.Text _
(re.Replace(c.Value, ""), """Ext. ""0")
End If
If Not Intersect(c, rMapsCo) Is Nothing _
And c.Row < 1 Then
c.Value = Application.WorksheetFunction.Text _
(re.Replace(c.Value, ""), """!Map ""0000 ""\<""00-00""\""")
End If
Next c
....
==========================================

Also, for each segment (telephone, extension, MapsCo) you could test each
result for proper data, depending on the requirements, as I mentioned before.

If you have questions about the various code segments, feel free to ask.

In particular the Regular Expression pattern "\D+" refers to any characters in
the string that are not digits (i.e. not in the set [0-9]). the Replace
methods replaces all matches (all non-digits) with a null string.

The rest is pretty straightforward.
--ron

Hey Ron,

Two out of three really work well, Thank you.

The MapsCo (column 24) lost all of it alpha characters.

In response to your question, the phone numbers are treated as text.
As is the MapsCo string.

The MapsCo data consist of 3 digits with three letters followed by two
digits for the eight base characters. After formatting it appears as
Map 000@ <@@-00

Example:
Data: 426rmk24
Formatted: Map 426R <MK-24

The code removed all of the alpha characters along with all non number
characters. I need those alpha characters.

I can't seem to figure out where to put the MapsCo formatting code
without stripping out the alpha characters. The re.Pattern = "\D+"
seems to be the problem. How do I strip everything but the
alpha-numeric characters and change all alpha characters to lower
case? And then apply the formatting.

Any ideas:

-Minitman

On Fri, 13 Jun 2008 22:18:34 -0400, Ron Rosenfeld
wrote:

On Fri, 13 Jun 2008 19:14:02 -0500, Minitman
wrote:

I had left out the Case 24 (the formatting that Peter T came up with
using Rick's "voodoo" formatting trick back in Jul 10, 2007) since I
thought it would be a less cluttered post and that it should be a
simple matter to reintegrate it into the final code, silly me.

But I don't understand vbscript or what is actually happening! I'm a
little afraid to start modifying code I don't understand!

Are there any special tricks that I should be aware of when attempting
to utilize and or modify your suggestions?

1. Rick's routine returns your result as a text string. Mine and Doug's return
a number formatted as a telephone number or extension. They would both appear
the same in the cell -- but Text and Numbers will behave differently in
formulas.

2. You would have to add the Column 24 to my list of both an acceptable Target
and also for a different format. Could you give an example of what it would
look like? And does the data in Column 24 also require removal of all
non-digits?

If so, mine is easily modified to something like:


================================
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rTel As Range, rExt As Range, c As Range
Dim col As Object
Dim rMapsCo As Range
Dim re As Object

Set rTel = Union(Columns(19), Columns(21), Columns(37), Columns(39), _
Columns(41), Columns(43), Columns(45), Columns(47), _
Columns(49), Columns(51), Columns(53), Columns(55))

Set rExt = Union(Columns(20), Columns(22), Columns(38), Columns(42), _
Columns(44), Columns(46), Columns(48), Columns(50), _
Columns(52), Columns(54), Columns(56))

Set rMapsCo = Columns(24)

If Not Intersect(Target, Union(rTel, rExt, rMapsCo)) Is Nothing Then
Application.EnableEvents = False
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.Pattern = "\D+"
For Each c In Target
If Not Intersect(c, rTel) Is Nothing _
And c.Row < 1 Then
c.Value = re.Replace(c.Value, "")
c.NumberFormat = "[<=9999999]###-####;(###) ###-####"
End If
If Not Intersect(c, rExt) Is Nothing _
And c.Row < 1 Then
c.Value = re.Replace(c.Value, "")
c.NumberFormat = """Ext. ""0"
End If
If Not Intersect(c, rMapsCo) Is Nothing _
And c.Row < 1 Then
c.Value = re.Replace(c.Value, "")
c.NumberFormat = """!Map ""0000 ""\<""00-00""\"""
End If
Next c
Application.EnableEvents = True
End If
End Sub
=================================

IF you prefer a text string output, then you can change the lines that output
the values, as in below:

============================
...
For Each c In Target
If Not Intersect(c, rTel) Is Nothing _
And c.Row < 1 Then
c.Value = Application.WorksheetFunction.Text _
(re.Replace(c.Value, ""), "[<=9999999]###-####;(###) ###-####")
End If
If Not Intersect(c, rExt) Is Nothing _
And c.Row < 1 Then
c.Value = Application.WorksheetFunction.Text _
(re.Replace(c.Value, ""), """Ext. ""0")
End If
If Not Intersect(c, rMapsCo) Is Nothing _
And c.Row < 1 Then
c.Value = Application.WorksheetFunction.Text _
(re.Replace(c.Value, ""), """!Map ""0000 ""\<""00-00""\""")
End If
Next c
...
==========================================

Also, for each segment (telephone, extension, MapsCo) you could test each
result for proper data, depending on the requirements, as I mentioned before.

If you have questions about the various code segments, feel free to ask.

In particular the Regular Expression pattern "\D+" refers to any characters in
the string that are not digits (i.e. not in the set [0-9]). the Replace
methods replaces all matches (all non-digits) with a null string.

The rest is pretty straightforward.
--ron

On Fri, 13 Jun 2008 19:14:02 -0500, Minitman
wrote:

Are there any special tricks that I should be aware of when attempting
to utilize and or modify your suggestions?

One other "trick".

Running the sub will, itself, trigger a worksheet change event, so it's
important to have the application.enableevents = false line in there. But, if
you make an entry that causes an error, when things stop, events will still be
disabled.

So you should have a macro you can run to re-enable the events, just in case.
That macro can be pretty simple:

=================
Sub Enable()
Application.EnableEvents = True
End Sub
=====================
--ron