ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Remove Alpha Characters (https://www.excelbanter.com/excel-programming/412539-remove-alpha-characters.html)

Minitman
Remove Alpha Characters
 
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

Rick Rothstein \(MVP - VB\)[_2102_]
Remove Alpha Characters
 
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


Rick Rothstein \(MVP - VB\)[_2103_]
Remove Alpha Characters
 
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

Doug Glancy
Remove Alpha Characters
 
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



Doug Glancy
Remove Alpha Characters
 
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

Ron Rosenfeld
Remove Alpha Characters
 
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

Ron Rosenfeld
Remove Alpha Characters
 
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 Rothstein \(MVP - VB\)[_2105_]
Remove Alpha Characters
 
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

Minitman
Remove Alpha Characters
 
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

Ron Rosenfeld
Remove Alpha Characters
 
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

Ron Rosenfeld
Remove Alpha Characters
 
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

Ron Rosenfeld
Remove Alpha Characters
 
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

Rick Rothstein \(MVP - VB\)[_2116_]
Remove Alpha Characters
 
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


Ron Rosenfeld
Remove Alpha Characters
 
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 Rothstein \(MVP - VB\)[_2121_]
Remove Alpha Characters
 
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?

Well, yeah, there is **that** problem also.<g I can't believe I did that!

And the **actual** corrected formula is...

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or Intersect(Target, _
Union(Range("S:V"), Range("AK:BD"))) Is Nothing Then Exit Sub

Thanks for sticking with me on this until what was wrong finally sank into
my thick skull.<g

Rick


Minitman
Remove Alpha Characters
 
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

Rick Rothstein \(MVP - VB\)[_2124_]
Remove Alpha Characters
 
Going back to my construction... does this do what you want?

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X"), Range("AK:BD"))) _
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 And Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then
Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
S = Format(S, "!Map @@@@ \<@@-@@\")
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
...
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

Ron Rosenfeld
Remove Alpha Characters
 
On Sun, 15 Jun 2008 02:08:25 -0500, Minitman
wrote:

Two out of three really work well, Thank you.

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

As I wrote, that's how it was designed. But easy to change.


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

That makes things easier, as we don't have to be concerned about the formatting
of the target cell.


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


Now with the full information, try this:

================================================== ============
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 = Application.WorksheetFunction.Text _
(re.Replace(c.Value, ""), "[<=9999999]###-####;(###) ###-####")
End If
If Not Intersect(c, rExt) Is Nothing _
And c.Row < 1 Then
c.Value = Format(re.Replace(c.Value, ""), """Ext. ""0")
End If
If Not Intersect(c, rMapsCo) Is Nothing _
And c.Row < 1 Then
c.Value = Format(c.Value, "!Map @@@@ \<@@-@@\")
End If
Next c
Application.EnableEvents = True
End If
End Sub
===================================

Also, please note that the code does not test for valid entries. If you want
to do that, outline all valid entry ranges and this can be easily added.
--ron

Ron Rosenfeld
Remove Alpha Characters
 
On Sun, 15 Jun 2008 02:08:25 -0500, Minitman
wrote:

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:

Here's another version with some validity testing for the entries. This
testing may or may not be appropriate for your requirements. Especially, it
will flag some non-US phone numbers as invalid.

Telephone numbers must be 7, 10 or 11 digits -- if 11, the leading digit is
omitted.

I did not include any testing for valid extension numbers.

I did include that the MapsCo needed to be in the format you described above.

Note the Option Compare Text statement at the beginning of the module. Without
this, the MapsCo testing would be case sensitive on many systems.

Also note that the error message is written to the cell, along with the
original content.

==================================
Option Explicit
Option Compare Text
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
Dim str

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
str = re.Replace(c.Value, "")
Select Case Len(str)
Case Is = 7, 10, 11
str = Right(str, 10)
c.Value = Application.WorksheetFunction.Text _
(str, "[<=9999999]###-####;(###) ###-####")
Case Else
c.Value = c.Value & " is an Invalid Phone Number"
End Select
End If
If Not Intersect(c, rExt) Is Nothing _
And c.Row < 1 Then
c.Value = Format(re.Replace(c.Value, ""), """Ext. ""0")
End If
If Not Intersect(c, rMapsCo) Is Nothing _
And c.Row < 1 Then
If c.Value Like "###[A-Z][A-Z][A-Z]##" Then
c.Value = Format(c.Value, "!Map @@@@ \<@@-@@\")
Else
c.Value = c.Value & " is an invalid map code"
End If
End If
Next c
Application.EnableEvents = True
End If
End Sub
=====================================
--ron

Minitman
Remove Alpha Characters
 
Good morning Rick,

Good to hear from you again.

There seems to be a problem with this code. It hangs up on the on the
if statement at this place:


With the error message:

Run-time error '1004':
Method 'Range" of object '_Worksheet' failed

Debug highlighted this line:

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X"),
Range("AK:BD"))) _
Is Nothing Then Exit Sub

Breaking up this line at the 'Or's, I was able to eliminate all but
this code snippet:

....Union(Range("S:V"), Range("X"), Range("AK:BD"))...

Which looks good to me but not to debug.

I'm not sure if I did this elimination process right or not, but that
was all I could think of to try.

Other then that, I got no further.

Is there an easy fix?

Please let me know.

Thanks.

-Minitman


On Sun, 15 Jun 2008 05:44:57 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

Going back to my construction... does this do what you want?

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X"), Range("AK:BD"))) _
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 And Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then
Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
S = Format(S, "!Map @@@@ \<@@-@@\")
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
.. .
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

Rick Rothstein \(MVP - VB\)[_2125_]
Remove Alpha Characters
 
That Range("X") was supposed to have been Range("X:X"). Try changing the
line to this and see if it works...

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"), Range("AK:BD"))) _
Is Nothing Then Exit Sub

Rick


"Minitman" wrote in message
...
Good morning Rick,

Good to hear from you again.

There seems to be a problem with this code. It hangs up on the on the
if statement at this place:


With the error message:

Run-time error '1004':
Method 'Range" of object '_Worksheet' failed

Debug highlighted this line:

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X"),
Range("AK:BD"))) _
Is Nothing Then Exit Sub

Breaking up this line at the 'Or's, I was able to eliminate all but
this code snippet:

...Union(Range("S:V"), Range("X"), Range("AK:BD"))...

Which looks good to me but not to debug.

I'm not sure if I did this elimination process right or not, but that
was all I could think of to try.

Other then that, I got no further.

Is there an easy fix?

Please let me know.

Thanks.

-Minitman


On Sun, 15 Jun 2008 05:44:57 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

Going back to my construction... does this do what you want?

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X"), Range("AK:BD"))) _
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 And Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then
Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
S = Format(S, "!Map @@@@ \<@@-@@\")
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
. ..
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

Minitman
Remove Alpha Characters
 
Good morning Ron,

Thanks for the reply.

This modification works as you described it, even down to the
limitation.

I did forget to mention that the parameters that I gave you were for
the ideal situation, not necessarily the actual situation. In
particular sometimes the data will be passed already formatted. This
modification will just add the error message to it (which is not what
I need). I need the entry to be stripped down to the base format of
000xxx00 from whatever format it is entered in with. I have some
legacy data that was formatted with different formats over time. Some
of these formats include {}'s, []'s, shorter numbers or other missing
data. If the stripped down meets the same criteria as newly entered
data then it needs to be formatted with the "Map 000X <XX-00" format.
The purpose is for either manual entry into the cell, entry from a
UserForm or entry from the Print_Form sheet (to correct miss entered
data).

Speaking of the Print_Form sheet, there is one additional
consideration, this code below is for the data sheet, I have the same
formatting consideration for the Print_Form sheet, with this one major
difference - I am addressing named ranges instead of columns. A
ComboBox picks the customer record to populate all of the named ranges
(80 of them) and then with the click of a CommandButton either changes
the data (Edit mode), verifies the data or prints the data. In this
sheet the named range cells are formatted for the type of data
displayed. This should be a simple matter of replacing the column
references with named range references - I hope

Any ideas or thoughts on the MapsCo formatting problem?

Again thanks for your help.

-Minitman


On Sun, 15 Jun 2008 07:38:13 -0400, Ron Rosenfeld
wrote:

On Sun, 15 Jun 2008 02:08:25 -0500, Minitman
wrote:

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:

Here's another version with some validity testing for the entries. This
testing may or may not be appropriate for your requirements. Especially, it
will flag some non-US phone numbers as invalid.

Telephone numbers must be 7, 10 or 11 digits -- if 11, the leading digit is
omitted.

I did not include any testing for valid extension numbers.

I did include that the MapsCo needed to be in the format you described above.

Note the Option Compare Text statement at the beginning of the module. Without
this, the MapsCo testing would be case sensitive on many systems.

Also note that the error message is written to the cell, along with the
original content.

==================================
Option Explicit
Option Compare Text
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
Dim str

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
str = re.Replace(c.Value, "")
Select Case Len(str)
Case Is = 7, 10, 11
str = Right(str, 10)
c.Value = Application.WorksheetFunction.Text _
(str, "[<=9999999]###-####;(###) ###-####")
Case Else
c.Value = c.Value & " is an Invalid Phone Number"
End Select
End If
If Not Intersect(c, rExt) Is Nothing _
And c.Row < 1 Then
c.Value = Format(re.Replace(c.Value, ""), """Ext. ""0")
End If
If Not Intersect(c, rMapsCo) Is Nothing _
And c.Row < 1 Then
If c.Value Like "###[A-Z][A-Z][A-Z]##" Then
c.Value = Format(c.Value, "!Map @@@@ \<@@-@@\")
Else
c.Value = c.Value & " is an invalid map code"
End If
End If
Next c
Application.EnableEvents = True
End If
End Sub
=====================================
--ron

Minitman
Remove Alpha Characters
 
That fixed the error - Thanks

However, now that the code is running, the problem with the MapsCo
formatting is revealed.

This code strips everything but numeric portion of the input (Just as
you said it would, I didn't see the implications of that fact) and
then tries to format that - unfortunately the raw data is missing 3
alpha characters. The raw data should be 000xxxx00 with 0's = to
numbers and x's = to lowercase alpha characters, which are then
reformatted as "Map 000X <XX-00" again the 0's are numbers but the
X's = Upper case alpha characters. The finale format works, it just
needs the raw data in the correct format. I am not sure how to do
that, even the original solution from 7/10/2007 does not seem to be
working.

Any ideas on this matter?

Again, thanks for help so far.

-Minitman

On Sun, 15 Jun 2008 12:36:11 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

That Range("X") was supposed to have been Range("X:X"). Try changing the
line to this and see if it works...

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"), Range("AK:BD"))) _
Is Nothing Then Exit Sub

Rick


"Minitman" wrote in message
.. .
Good morning Rick,

Good to hear from you again.

There seems to be a problem with this code. It hangs up on the on the
if statement at this place:


With the error message:

Run-time error '1004':
Method 'Range" of object '_Worksheet' failed

Debug highlighted this line:

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X"),
Range("AK:BD"))) _
Is Nothing Then Exit Sub

Breaking up this line at the 'Or's, I was able to eliminate all but
this code snippet:

...Union(Range("S:V"), Range("X"), Range("AK:BD"))...

Which looks good to me but not to debug.

I'm not sure if I did this elimination process right or not, but that
was all I could think of to try.

Other then that, I got no further.

Is there an easy fix?

Please let me know.

Thanks.

-Minitman


On Sun, 15 Jun 2008 05:44:57 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

Going back to my construction... does this do what you want?

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X"), Range("AK:BD"))) _
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 And Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then
Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
S = Format(S, "!Map @@@@ \<@@-@@\")
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
...
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

Rick Rothstein \(MVP - VB\)[_2126_]
Remove Alpha Characters
 
I just read your latest message to Ron about Column "X" values possibly
being already formatted when entered. Here is my code which should handle
that (and which contains the corrections previously posted), see if it does
what you want...

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"), Range("AK:BD"))) _
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 Then
If UCase(Left(S, 3)) = "MAP" Then S = Mid(S, 4)
If Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
S = Format(S, "!Map @@@@ \<@@-@@\")
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



"Rick Rothstein (MVP - VB)" wrote in
message ...
That Range("X") was supposed to have been Range("X:X"). Try changing the
line to this and see if it works...

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"), Range("AK:BD"))) _
Is Nothing Then Exit Sub

Rick


"Minitman" wrote in message
...
Good morning Rick,

Good to hear from you again.

There seems to be a problem with this code. It hangs up on the on the
if statement at this place:


With the error message:

Run-time error '1004':
Method 'Range" of object '_Worksheet' failed

Debug highlighted this line:

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X"),
Range("AK:BD"))) _
Is Nothing Then Exit Sub

Breaking up this line at the 'Or's, I was able to eliminate all but
this code snippet:

...Union(Range("S:V"), Range("X"), Range("AK:BD"))...

Which looks good to me but not to debug.

I'm not sure if I did this elimination process right or not, but that
was all I could think of to try.

Other then that, I got no further.

Is there an easy fix?

Please let me know.

Thanks.

-Minitman


On Sun, 15 Jun 2008 05:44:57 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

Going back to my construction... does this do what you want?

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X"), Range("AK:BD"))) _
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 And Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then
Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
S = Format(S, "!Map @@@@ \<@@-@@\")
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
...
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

Rick Rothstein \(MVP - VB\)[_2127_]
Remove Alpha Characters
 
Try this (it forces the upper casing and it allows for the entry to already
be in the right format)...

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"), Range("AK:BD"))) _
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 Then
If Left(S, 3) = "Map" Then S = Mid(S, 4)
If Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
S = Format(UCase(S), "!Map @@@@ \<@@-@@\")
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
...
That fixed the error - Thanks

However, now that the code is running, the problem with the MapsCo
formatting is revealed.

This code strips everything but numeric portion of the input (Just as
you said it would, I didn't see the implications of that fact) and
then tries to format that - unfortunately the raw data is missing 3
alpha characters. The raw data should be 000xxxx00 with 0's = to
numbers and x's = to lowercase alpha characters, which are then
reformatted as "Map 000X <XX-00" again the 0's are numbers but the
X's = Upper case alpha characters. The finale format works, it just
needs the raw data in the correct format. I am not sure how to do
that, even the original solution from 7/10/2007 does not seem to be
working.

Any ideas on this matter?

Again, thanks for help so far.

-Minitman

On Sun, 15 Jun 2008 12:36:11 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

That Range("X") was supposed to have been Range("X:X"). Try changing the
line to this and see if it works...

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"), Range("AK:BD"))) _
Is Nothing Then Exit Sub

Rick


"Minitman" wrote in message
. ..
Good morning Rick,

Good to hear from you again.

There seems to be a problem with this code. It hangs up on the on the
if statement at this place:


With the error message:

Run-time error '1004':
Method 'Range" of object '_Worksheet' failed

Debug highlighted this line:

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X"),
Range("AK:BD"))) _
Is Nothing Then Exit Sub

Breaking up this line at the 'Or's, I was able to eliminate all but
this code snippet:

...Union(Range("S:V"), Range("X"), Range("AK:BD"))...

Which looks good to me but not to debug.

I'm not sure if I did this elimination process right or not, but that
was all I could think of to try.

Other then that, I got no further.

Is there an easy fix?

Please let me know.

Thanks.

-Minitman


On Sun, 15 Jun 2008 05:44:57 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

Going back to my construction... does this do what you want?

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X"), Range("AK:BD")))
_
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 And Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then
Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
S = Format(S, "!Map @@@@ \<@@-@@\")
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
m...
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

Minitman
Remove Alpha Characters
 
Hey Rick,

Your code takes care of the pre formatted scenario, but not the bad
data scenario.

If I try to enter anything, the code will put as much of the data that
it can into the MapsCo format (Map #### <##-##) without regard as to
what the characters are (if I put two many characters in, it takes
only the last 8 characters, whatever they are). For the MapsCo format
the raw data needs to be three numbers then three alpha characters
followed by two numbers for a total of eight characters. This it will
format properly.

Is there a way to check for this?

-Minitman

On Sun, 15 Jun 2008 13:33:17 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

I just read your latest message to Ron about Column "X" values possibly
being already formatted when entered. Here is my code which should handle
that (and which contains the corrections previously posted), see if it does
what you want...

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"), Range("AK:BD"))) _
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 Then
If UCase(Left(S, 3)) = "MAP" Then S = Mid(S, 4)
If Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
S = Format(S, "!Map @@@@ \<@@-@@\")
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



"Rick Rothstein (MVP - VB)" wrote in
message ...
That Range("X") was supposed to have been Range("X:X"). Try changing the
line to this and see if it works...

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"), Range("AK:BD"))) _
Is Nothing Then Exit Sub

Rick


"Minitman" wrote in message
...
Good morning Rick,

Good to hear from you again.

There seems to be a problem with this code. It hangs up on the on the
if statement at this place:


With the error message:

Run-time error '1004':
Method 'Range" of object '_Worksheet' failed

Debug highlighted this line:

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X"),
Range("AK:BD"))) _
Is Nothing Then Exit Sub

Breaking up this line at the 'Or's, I was able to eliminate all but
this code snippet:

...Union(Range("S:V"), Range("X"), Range("AK:BD"))...

Which looks good to me but not to debug.

I'm not sure if I did this elimination process right or not, but that
was all I could think of to try.

Other then that, I got no further.

Is there an easy fix?

Please let me know.

Thanks.

-Minitman


On Sun, 15 Jun 2008 05:44:57 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

Going back to my construction... does this do what you want?

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X"), Range("AK:BD"))) _
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 And Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then
Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
S = Format(S, "!Map @@@@ \<@@-@@\")
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
m...
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

Rick Rothstein \(MVP - VB\)[_2130_]
Remove Alpha Characters
 
You didn't say what you wanted to do for improper entries in Column 24, so I
returned the entry surrounded by <?? tags... you can change this by
modifying the code in the Case 24 statement block. Here is the code...

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"), Range("AK:BD"))) _
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 Then
If UCase(Left(S, 3)) = "MAP" Then S = Mid(S, 4)
If Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
If S Like "###[a-zA-Z][a-zA-Z][a-zA-Z]##" Then
S = Format(S, "!Map @@@@ \<@@-@@\")
Else
S = "<??" & Target.Value & "<??"
End If
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
...
Hey Rick,

Your code takes care of the pre formatted scenario, but not the bad
data scenario.

If I try to enter anything, the code will put as much of the data that
it can into the MapsCo format (Map #### <##-##) without regard as to
what the characters are (if I put two many characters in, it takes
only the last 8 characters, whatever they are). For the MapsCo format
the raw data needs to be three numbers then three alpha characters
followed by two numbers for a total of eight characters. This it will
format properly.

Is there a way to check for this?

-Minitman

On Sun, 15 Jun 2008 13:33:17 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

I just read your latest message to Ron about Column "X" values possibly
being already formatted when entered. Here is my code which should handle
that (and which contains the corrections previously posted), see if it
does
what you want...

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"), Range("AK:BD")))
_
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 Then
If UCase(Left(S, 3)) = "MAP" Then S = Mid(S, 4)
If Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
S = Format(S, "!Map @@@@ \<@@-@@\")
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



"Rick Rothstein (MVP - VB)" wrote in
message ...
That Range("X") was supposed to have been Range("X:X"). Try changing the
line to this and see if it works...

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"), Range("AK:BD"))) _
Is Nothing Then Exit Sub

Rick


"Minitman" wrote in message
...
Good morning Rick,

Good to hear from you again.

There seems to be a problem with this code. It hangs up on the on the
if statement at this place:


With the error message:

Run-time error '1004':
Method 'Range" of object '_Worksheet' failed

Debug highlighted this line:

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X"),
Range("AK:BD"))) _
Is Nothing Then Exit Sub

Breaking up this line at the 'Or's, I was able to eliminate all but
this code snippet:

...Union(Range("S:V"), Range("X"), Range("AK:BD"))...

Which looks good to me but not to debug.

I'm not sure if I did this elimination process right or not, but that
was all I could think of to try.

Other then that, I got no further.

Is there an easy fix?

Please let me know.

Thanks.

-Minitman


On Sun, 15 Jun 2008 05:44:57 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

Going back to my construction... does this do what you want?

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X"), Range("AK:BD")))
_
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 And Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then
Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
S = Format(S, "!Map @@@@ \<@@-@@\")
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
om...
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

Ron Rosenfeld
Remove Alpha Characters
 
On Sun, 15 Jun 2008 12:12:05 -0500, Minitman
wrote:

ood morning Ron,

Thanks for the reply.

This modification works as you described it, even down to the
limitation.

I did forget to mention that the parameters that I gave you were for
the ideal situation, not necessarily the actual situation. In
particular sometimes the data will be passed already formatted. This
modification will just add the error message to it (which is not what
I need). I need the entry to be stripped down to the base format of
000xxx00 from whatever format it is entered in with. I have some
legacy data that was formatted with different formats over time. Some
of these formats include {}'s, []'s, shorter numbers or other missing
data. If the stripped down meets the same criteria as newly entered
data then it needs to be formatted with the "Map 000X <XX-00" format.
The purpose is for either manual entry into the cell, entry from a
UserForm or entry from the Print_Form sheet (to correct miss entered
data).

Speaking of the Print_Form sheet, there is one additional
consideration, this code below is for the data sheet, I have the same
formatting consideration for the Print_Form sheet, with this one major
difference - I am addressing named ranges instead of columns. A
ComboBox picks the customer record to populate all of the named ranges
(80 of them) and then with the click of a CommandButton either changes
the data (Edit mode), verifies the data or prints the data. In this
sheet the named range cells are formatted for the type of data
displayed. This should be a simple matter of replacing the column
references with named range references - I hope

Any ideas or thoughts on the MapsCo formatting problem?


From what you what you write, I am guessing that if, regardless of the format,
the stripped MapsCo data is not in the form of 000xxx00 then it should be
flagged as invalid.

That being the case, perhaps this will work:

=====================================
Option Explicit
Option Compare Text
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
Dim str

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.IgnoreCase = True
For Each c In Target
If Not Intersect(c, rTel) Is Nothing _
And c.Row < 1 And Len(c.Value) 0 Then
re.Pattern = "\D+"
str = re.Replace(c.Value, "")
Select Case Len(str)
Case Is = 7, 10, 11
str = Right(str, 10)
c.Value = Application.WorksheetFunction.Text _
(str, "[<=9999999]###-####;(###) ###-####")
Case Else
c.Value = c.Value & " is an Invalid Phone Number"
End Select
End If
If Not Intersect(c, rExt) Is Nothing _
And c.Row < 1 And Len(c.Value) 0 Then
re.Pattern = "\D+"
c.Value = Format(re.Replace(c.Value, ""), """Ext. ""0")
End If
If Not Intersect(c, rMapsCo) Is Nothing _
And c.Row < 1 And Len(c.Value) 0 Then
re.Pattern = "^\D*" 'remove leading non-digits
str = re.Replace(c.Value, "")
re.Pattern = "[^0-9A-Z]" 'remove subsequent non-alphanumerics
str = re.Replace(str, "")
If str Like "###[A-Z][A-Z][A-Z]##" Then
c.Value = Format(str, "!Map @@@@ \<@@-@@\")
Else
c.Value = c.Value & " is an invalid map code"
End If
End If
Next c
Application.EnableEvents = True
End If
End Sub
=================================
--ron

Minitman
Remove Alpha Characters
 
Hey Ron,

Thanks again for all of the help. This seems to be working on the
customer info sheet.

I can't seem to get it to work on the print form sheet.

Is it possible to use this code with named ranges instead of columns?

If so, how?

-Minitman

On Sun, 15 Jun 2008 15:52:52 -0400, Ron Rosenfeld
wrote:

On Sun, 15 Jun 2008 12:12:05 -0500, Minitman
wrote:

ood morning Ron,

Thanks for the reply.

This modification works as you described it, even down to the
limitation.

I did forget to mention that the parameters that I gave you were for
the ideal situation, not necessarily the actual situation. In
particular sometimes the data will be passed already formatted. This
modification will just add the error message to it (which is not what
I need). I need the entry to be stripped down to the base format of
000xxx00 from whatever format it is entered in with. I have some
legacy data that was formatted with different formats over time. Some
of these formats include {}'s, []'s, shorter numbers or other missing
data. If the stripped down meets the same criteria as newly entered
data then it needs to be formatted with the "Map 000X <XX-00" format.
The purpose is for either manual entry into the cell, entry from a
UserForm or entry from the Print_Form sheet (to correct miss entered
data).

Speaking of the Print_Form sheet, there is one additional
consideration, this code below is for the data sheet, I have the same
formatting consideration for the Print_Form sheet, with this one major
difference - I am addressing named ranges instead of columns. A
ComboBox picks the customer record to populate all of the named ranges
(80 of them) and then with the click of a CommandButton either changes
the data (Edit mode), verifies the data or prints the data. In this
sheet the named range cells are formatted for the type of data
displayed. This should be a simple matter of replacing the column
references with named range references - I hope

Any ideas or thoughts on the MapsCo formatting problem?


From what you what you write, I am guessing that if, regardless of the format,
the stripped MapsCo data is not in the form of 000xxx00 then it should be
flagged as invalid.

That being the case, perhaps this will work:

=====================================
Option Explicit
Option Compare Text
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
Dim str

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.IgnoreCase = True
For Each c In Target
If Not Intersect(c, rTel) Is Nothing _
And c.Row < 1 And Len(c.Value) 0 Then
re.Pattern = "\D+"
str = re.Replace(c.Value, "")
Select Case Len(str)
Case Is = 7, 10, 11
str = Right(str, 10)
c.Value = Application.WorksheetFunction.Text _
(str, "[<=9999999]###-####;(###) ###-####")
Case Else
c.Value = c.Value & " is an Invalid Phone Number"
End Select
End If
If Not Intersect(c, rExt) Is Nothing _
And c.Row < 1 And Len(c.Value) 0 Then
re.Pattern = "\D+"
c.Value = Format(re.Replace(c.Value, ""), """Ext. ""0")
End If
If Not Intersect(c, rMapsCo) Is Nothing _
And c.Row < 1 And Len(c.Value) 0 Then
re.Pattern = "^\D*" 'remove leading non-digits
str = re.Replace(c.Value, "")
re.Pattern = "[^0-9A-Z]" 'remove subsequent non-alphanumerics
str = re.Replace(str, "")
If str Like "###[A-Z][A-Z][A-Z]##" Then
c.Value = Format(str, "!Map @@@@ \<@@-@@\")
Else
c.Value = c.Value & " is an invalid map code"
End If
End If
Next c
Application.EnableEvents = True
End If
End Sub
=================================
--ron

Minitman
Remove Alpha Characters
 
Thanks Rick,

You made a good assumption, which works for me.

I now need to migrate this code to a different sheet. This sheet
(Cust_Info) needs to look at columns. The new sheet (Print_Form)
needs to look at named ranges instead. I also posed this question to
Ron about his code. I don't see how to do this with either set of
code.

Is there a way?

If so, how?

Again, I want to thank you for taking the time to help, it is greatly
appreciated. Both you and Ron.

-Minitman



On Sun, 15 Jun 2008 15:37:41 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

You didn't say what you wanted to do for improper entries in Column 24, so I
returned the entry surrounded by <?? tags... you can change this by
modifying the code in the Case 24 statement block. Here is the code...

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"), Range("AK:BD"))) _
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 Then
If UCase(Left(S, 3)) = "MAP" Then S = Mid(S, 4)
If Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
If S Like "###[a-zA-Z][a-zA-Z][a-zA-Z]##" Then
S = Format(S, "!Map @@@@ \<@@-@@\")
Else
S = "<??" & Target.Value & "<??"
End If
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
.. .
Hey Rick,

Your code takes care of the pre formatted scenario, but not the bad
data scenario.

If I try to enter anything, the code will put as much of the data that
it can into the MapsCo format (Map #### <##-##) without regard as to
what the characters are (if I put two many characters in, it takes
only the last 8 characters, whatever they are). For the MapsCo format
the raw data needs to be three numbers then three alpha characters
followed by two numbers for a total of eight characters. This it will
format properly.

Is there a way to check for this?

-Minitman

On Sun, 15 Jun 2008 13:33:17 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

I just read your latest message to Ron about Column "X" values possibly
being already formatted when entered. Here is my code which should handle
that (and which contains the corrections previously posted), see if it
does
what you want...

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"), Range("AK:BD")))
_
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 Then
If UCase(Left(S, 3)) = "MAP" Then S = Mid(S, 4)
If Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
S = Format(S, "!Map @@@@ \<@@-@@\")
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



"Rick Rothstein (MVP - VB)" wrote in
message ...
That Range("X") was supposed to have been Range("X:X"). Try changing the
line to this and see if it works...

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"), Range("AK:BD"))) _
Is Nothing Then Exit Sub

Rick


"Minitman" wrote in message
...
Good morning Rick,

Good to hear from you again.

There seems to be a problem with this code. It hangs up on the on the
if statement at this place:


With the error message:

Run-time error '1004':
Method 'Range" of object '_Worksheet' failed

Debug highlighted this line:

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X"),
Range("AK:BD"))) _
Is Nothing Then Exit Sub

Breaking up this line at the 'Or's, I was able to eliminate all but
this code snippet:

...Union(Range("S:V"), Range("X"), Range("AK:BD"))...

Which looks good to me but not to debug.

I'm not sure if I did this elimination process right or not, but that
was all I could think of to try.

Other then that, I got no further.

Is there an easy fix?

Please let me know.

Thanks.

-Minitman


On Sun, 15 Jun 2008 05:44:57 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

Going back to my construction... does this do what you want?

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X"), Range("AK:BD")))
_
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 And Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then
Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
S = Format(S, "!Map @@@@ \<@@-@@\")
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
news:f7d954918l80a5p6kv1aulha5ctbctiaf3@4ax. com...
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

Rick Rothstein \(MVP - VB\)[_2131_]
Remove Alpha Characters
 
I think it might be a good idea to describe these ranges for us. The reason
I suggest that is if you were processing your Print_From sheet by simple
columns (as you did on your Cust_Info sheet), then using similar column
ranges like my code does would seem to be a rather straight-forward
conversion process.

Rick

"Minitman" wrote in message
...
Thanks Rick,

You made a good assumption, which works for me.

I now need to migrate this code to a different sheet. This sheet
(Cust_Info) needs to look at columns. The new sheet (Print_Form)
needs to look at named ranges instead. I also posed this question to
Ron about his code. I don't see how to do this with either set of
code.

Is there a way?

If so, how?

Again, I want to thank you for taking the time to help, it is greatly
appreciated. Both you and Ron.

-Minitman



On Sun, 15 Jun 2008 15:37:41 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

You didn't say what you wanted to do for improper entries in Column 24, so
I
returned the entry surrounded by <?? tags... you can change this by
modifying the code in the Case 24 statement block. Here is the code...

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"), Range("AK:BD")))
_
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 Then
If UCase(Left(S, 3)) = "MAP" Then S = Mid(S, 4)
If Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
If S Like "###[a-zA-Z][a-zA-Z][a-zA-Z]##" Then
S = Format(S, "!Map @@@@ \<@@-@@\")
Else
S = "<??" & Target.Value & "<??"
End If
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
. ..
Hey Rick,

Your code takes care of the pre formatted scenario, but not the bad
data scenario.

If I try to enter anything, the code will put as much of the data that
it can into the MapsCo format (Map #### <##-##) without regard as to
what the characters are (if I put two many characters in, it takes
only the last 8 characters, whatever they are). For the MapsCo format
the raw data needs to be three numbers then three alpha characters
followed by two numbers for a total of eight characters. This it will
format properly.

Is there a way to check for this?

-Minitman

On Sun, 15 Jun 2008 13:33:17 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

I just read your latest message to Ron about Column "X" values possibly
being already formatted when entered. Here is my code which should
handle
that (and which contains the corrections previously posted), see if it
does
what you want...

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"),
Range("AK:BD")))
_
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 Then
If UCase(Left(S, 3)) = "MAP" Then S = Mid(S, 4)
If Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
S = Format(S, "!Map @@@@ \<@@-@@\")
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



"Rick Rothstein (MVP - VB)" wrote
in
message ...
That Range("X") was supposed to have been Range("X:X"). Try changing
the
line to this and see if it works...

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"), Range("AK:BD")))
_
Is Nothing Then Exit Sub

Rick


"Minitman" wrote in message
...
Good morning Rick,

Good to hear from you again.

There seems to be a problem with this code. It hangs up on the on
the
if statement at this place:


With the error message:

Run-time error '1004':
Method 'Range" of object '_Worksheet' failed

Debug highlighted this line:

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X"),
Range("AK:BD"))) _
Is Nothing Then Exit Sub

Breaking up this line at the 'Or's, I was able to eliminate all but
this code snippet:

...Union(Range("S:V"), Range("X"), Range("AK:BD"))...

Which looks good to me but not to debug.

I'm not sure if I did this elimination process right or not, but that
was all I could think of to try.

Other then that, I got no further.

Is there an easy fix?

Please let me know.

Thanks.

-Minitman


On Sun, 15 Jun 2008 05:44:57 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

Going back to my construction... does this do what you want?

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X"),
Range("AK:BD")))
_
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 And Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then
Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
S = Format(S, "!Map @@@@ \<@@-@@\")
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
news:f7d954918l80a5p6kv1aulha5ctbctiaf3@4ax .com...
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

Ron Rosenfeld
Remove Alpha Characters
 
On Sun, 15 Jun 2008 18:25:50 -0500, Minitman
wrote:

Hey Ron,

Thanks again for all of the help. This seems to be working on the
customer info sheet.

I can't seem to get it to work on the print form sheet.

Is it possible to use this code with named ranges instead of columns?

Yes


If so, how?

Do your named ranges refer to columns?

If so, merely substitute the Named Range for the column.

e.g.:

Set rMapsCo = Range("foobar1")

Set rTel = Union(Range("foobar2"), Range("foobar3"), Range("foobar4"), _
etc.
--ron

Minitman
Remove Alpha Characters
 
Fair enough.

It is a form most of the rows are 17 points in height and the columns
are .44 points wide. This comes out to 30 rows by 104 columns.

I originally set this up for merged cells. Then I saw the light and
unmerged all but 4, (they are memo fields and cover 88 columns by one
row, which is 66 points high. The format of these memo field is set
to top left with word wrap on at text size of 12. Giving me about 5
lines of word wrapped text which will only wrap inside a cell thus the
need to merge each memo field).

Here is a list of locations of the named ranges (note: the 'columns
wide' figures are the named range + the blank spaces needed to format
them with "Centered Across Selection to give the same effect as merged
cells gave without the special care needed in vba to handle merged
cells)":

pfCell_2 = T7 (36 columns wide)
pfCell_3 = A12 (52 columns wide)
pfCell_4 = BA12 (52 columns wide)
pfCell_5 = CU4 (-7 columns wide)
pfCell_6 = CV4 (5 columns wide)
pfCell_7 = R3 (8 columns wide)
pfCell_8 = CZ7 (10 columns wide)
pfCell_9 = CZ6 (10 columns wide)
pfCell_10 = CZ5 (10 columns wide)
pfCell_11 = A10 (52 columns wide)
pfCell_12 = A11 (27 columns wide)
pfCell_13 = AB11 (11 columns wide)
pfCell_14 = AM11 (14 columns wide)
pfCell_15 = BA10 (52 columns wide)
pfCell_16 = BA11 (27 columns wide)
pfCell_17 = CB11 (11 columns wide)
pfCell_18 = CM11 (14 columns wide)
pfCell_19 = V14 (20 columns wide)
pfCell_20 = AP14 (11 columns wide)
pfCell_21 = BV14 (20 columns wide)
pfCell_22 = CP14 (11 columns wide)
pfCell_23 = Q27 (88 columns wide-merged)
pfCell_24 = AR26 (28 columns wide)
pfCell_25 = BJ3 (12 columns wide)
pfCell_26 = AL3 (12 columns wide)
pfCell_27 = CO3 (12 columns wide)
pfCell_28 = T4 (9 columns wide)
pfCell_29 = AC4 (21 columns wide)
pfCell_30 = AX4 (23 columns wide)
pfCell_31 = BU4 (9 columns wide)
pfCell_32 = T5 (9 columns wide)
pfCell_33 = AC5 (21 columns wide)
pfCell_34 = AX5 (23 columns wide)
pfCell_35 = BU5 (9 columns wide)
pfCell_36 = T6 (62 columns wide)
pfCell_37 = V15 (20 columns wide)
pfCell_38 = AP15 (11 columns wide)
pfCell_39 = V16 (20 columns wide)
pfCell_40 = AP16 (11 columns wide)
pfCell_41 = BV15 (20 columns wide)
pfCell_42 = CP15 (11 columns wide)
pfCell_43 = BV16 (20 columns wide)
pfCell_44 = CP16 (11 columns wide)
pfCell_45 = V17 (20 columns wide)
pfCell_46 = AP17 (11 columns wide)
pfCell_47 = BV17 (20 columns wide)
pfCell_48 = CP17 (11 columns wide)
pfCell_49 = V18 (20 columns wide)
pfCell_50 = AP18 (11 columns wide)
pfCell_51 = BV18 (20 columns wide)
pfCell_52 = CP18 (11 columns wide)
pfCell_53 = V19 (20 columns wide)
pfCell_54 = AP19 (11 columns wide)
pfCell_55 = BV19 (20 columns wide)
pfCell_56 = CP19 (11 columns wide)
pfCell_57 = M20 (92 columns wide)
pfCell_58 = M21 (92 columns wide)
pfCell_59 = A9 (8 columns wide)
pfCell_60 = I9 (4 columns wide)
pfCell_61 = M9 (31 columns wide)
pfCell_62 = AR9 (9 columns wide)
pfCell_63 = BA9 (8 columns wide)
pfCell_64 = BI9 (4 columns wide)
pfCell_65 = BM9 (31 columns wide)
pfCell_66 = CR9 (9 columns wide)
pfCell_67 = AE24 (13 columns wide)
pfCell_68 = Q24 (14 columns wide)
pfCell_69 = Q26 (14 columns wide)
pfCell_70 = A24 (16 columns wide)
pfCell_71 = BZ26 (27 columns wide)
pfCell_72 = A26 (16 columns wide)
pfCell_73 = AE26 (13 columns wide)
pfCell_74 = CB25 (25 columns wide)
pfCell_75 = AR24 (13 columns wide)
pfCell_76 = BE24 (15 columns wide)
pfCell_77 = CE24 (22 columns wide)
pfCell_78 = Q28 (88 columns wide-merged)
pfCell_79 = Q29 (88 columns wide-merged)
pfCell_80 = Q30 (88 columns wide-merged)

As you can see, the named ranges are all over the place!

The CustList sheet was set-up for data storage and retrieval. The
Print_Form sheet was set-up as a visual record to be printed and
stored as a hard copy back-up. It was based on a legacy form that we
have been using for 33 years (not computer generated). I was more
concerned with the people taking down the information not getting
confused with a totally different looking form and not knowing where
to put the information and what new information to ask for from new
customers as they called in for the first time on the phone.

If this is not enough information, feel free to ask for more.

I really appreciated your taking a look at my problem.

-Minitman



On Sun, 15 Jun 2008 20:26:15 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

I think it might be a good idea to describe these ranges for us. The reason
I suggest that is if you were processing your Print_From sheet by simple
columns (as you did on your Cust_Info sheet), then using similar column
ranges like my code does would seem to be a rather straight-forward
conversion process.

Rick

"Minitman" wrote in message
.. .
Thanks Rick,

You made a good assumption, which works for me.

I now need to migrate this code to a different sheet. This sheet
(Cust_Info) needs to look at columns. The new sheet (Print_Form)
needs to look at named ranges instead. I also posed this question to
Ron about his code. I don't see how to do this with either set of
code.

Is there a way?

If so, how?

Again, I want to thank you for taking the time to help, it is greatly
appreciated. Both you and Ron.

-Minitman



On Sun, 15 Jun 2008 15:37:41 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

You didn't say what you wanted to do for improper entries in Column 24, so
I
returned the entry surrounded by <?? tags... you can change this by
modifying the code in the Case 24 statement block. Here is the code...

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"), Range("AK:BD")))
_
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 Then
If UCase(Left(S, 3)) = "MAP" Then S = Mid(S, 4)
If Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
If S Like "###[a-zA-Z][a-zA-Z][a-zA-Z]##" Then
S = Format(S, "!Map @@@@ \<@@-@@\")
Else
S = "<??" & Target.Value & "<??"
End If
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
...
Hey Rick,

Your code takes care of the pre formatted scenario, but not the bad
data scenario.

If I try to enter anything, the code will put as much of the data that
it can into the MapsCo format (Map #### <##-##) without regard as to
what the characters are (if I put two many characters in, it takes
only the last 8 characters, whatever they are). For the MapsCo format
the raw data needs to be three numbers then three alpha characters
followed by two numbers for a total of eight characters. This it will
format properly.

Is there a way to check for this?

-Minitman

On Sun, 15 Jun 2008 13:33:17 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

I just read your latest message to Ron about Column "X" values possibly
being already formatted when entered. Here is my code which should
handle
that (and which contains the corrections previously posted), see if it
does
what you want...

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"),
Range("AK:BD")))
_
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 Then
If UCase(Left(S, 3)) = "MAP" Then S = Mid(S, 4)
If Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
S = Format(S, "!Map @@@@ \<@@-@@\")
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



"Rick Rothstein (MVP - VB)" wrote
in
message ...
That Range("X") was supposed to have been Range("X:X"). Try changing
the
line to this and see if it works...

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"), Range("AK:BD")))
_
Is Nothing Then Exit Sub

Rick


"Minitman" wrote in message
...
Good morning Rick,

Good to hear from you again.

There seems to be a problem with this code. It hangs up on the on
the
if statement at this place:


With the error message:

Run-time error '1004':
Method 'Range" of object '_Worksheet' failed

Debug highlighted this line:

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X"),
Range("AK:BD"))) _
Is Nothing Then Exit Sub

Breaking up this line at the 'Or's, I was able to eliminate all but
this code snippet:

...Union(Range("S:V"), Range("X"), Range("AK:BD"))...

Which looks good to me but not to debug.

I'm not sure if I did this elimination process right or not, but that
was all I could think of to try.

Other then that, I got no further.

Is there an easy fix?

Please let me know.

Thanks.

-Minitman


On Sun, 15 Jun 2008 05:44:57 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

Going back to my construction... does this do what you want?

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X"),
Range("AK:BD")))
_
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 And Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then
Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
S = Format(S, "!Map @@@@ \<@@-@@\")
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
news:f7d954918l80a5p6kv1aulha5ctbctiaf3@4a x.com...
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

Rick Rothstein \(MVP - VB\)[_2132_]
Remove Alpha Characters
 
Well, you gave me more information than I was expecting (I didn't need the
print layout stuff, but it did give me a sense of what you have to deal
with, so it was not a total loss). I'm glad to see your named ranges are
for single cells... I was half afraid we might be talking about rectangular
regions. Okay, to relate the previously posted code to this sheet, I need to
know which named ranges correspond to the 3 grouping (that is, MapsCo
Formatting, Telephone format and Extension format)... perhaps a 3-column
listing.

Rick


"Minitman" wrote in message
...
Fair enough.

It is a form most of the rows are 17 points in height and the columns
are .44 points wide. This comes out to 30 rows by 104 columns.

I originally set this up for merged cells. Then I saw the light and
unmerged all but 4, (they are memo fields and cover 88 columns by one
row, which is 66 points high. The format of these memo field is set
to top left with word wrap on at text size of 12. Giving me about 5
lines of word wrapped text which will only wrap inside a cell thus the
need to merge each memo field).

Here is a list of locations of the named ranges (note: the 'columns
wide' figures are the named range + the blank spaces needed to format
them with "Centered Across Selection to give the same effect as merged
cells gave without the special care needed in vba to handle merged
cells)":

pfCell_2 = T7 (36 columns wide)
pfCell_3 = A12 (52 columns wide)
pfCell_4 = BA12 (52 columns wide)
pfCell_5 = CU4 (-7 columns wide)
pfCell_6 = CV4 (5 columns wide)
pfCell_7 = R3 (8 columns wide)
pfCell_8 = CZ7 (10 columns wide)
pfCell_9 = CZ6 (10 columns wide)
pfCell_10 = CZ5 (10 columns wide)
pfCell_11 = A10 (52 columns wide)
pfCell_12 = A11 (27 columns wide)
pfCell_13 = AB11 (11 columns wide)
pfCell_14 = AM11 (14 columns wide)
pfCell_15 = BA10 (52 columns wide)
pfCell_16 = BA11 (27 columns wide)
pfCell_17 = CB11 (11 columns wide)
pfCell_18 = CM11 (14 columns wide)
pfCell_19 = V14 (20 columns wide)
pfCell_20 = AP14 (11 columns wide)
pfCell_21 = BV14 (20 columns wide)
pfCell_22 = CP14 (11 columns wide)
pfCell_23 = Q27 (88 columns wide-merged)
pfCell_24 = AR26 (28 columns wide)
pfCell_25 = BJ3 (12 columns wide)
pfCell_26 = AL3 (12 columns wide)
pfCell_27 = CO3 (12 columns wide)
pfCell_28 = T4 (9 columns wide)
pfCell_29 = AC4 (21 columns wide)
pfCell_30 = AX4 (23 columns wide)
pfCell_31 = BU4 (9 columns wide)
pfCell_32 = T5 (9 columns wide)
pfCell_33 = AC5 (21 columns wide)
pfCell_34 = AX5 (23 columns wide)
pfCell_35 = BU5 (9 columns wide)
pfCell_36 = T6 (62 columns wide)
pfCell_37 = V15 (20 columns wide)
pfCell_38 = AP15 (11 columns wide)
pfCell_39 = V16 (20 columns wide)
pfCell_40 = AP16 (11 columns wide)
pfCell_41 = BV15 (20 columns wide)
pfCell_42 = CP15 (11 columns wide)
pfCell_43 = BV16 (20 columns wide)
pfCell_44 = CP16 (11 columns wide)
pfCell_45 = V17 (20 columns wide)
pfCell_46 = AP17 (11 columns wide)
pfCell_47 = BV17 (20 columns wide)
pfCell_48 = CP17 (11 columns wide)
pfCell_49 = V18 (20 columns wide)
pfCell_50 = AP18 (11 columns wide)
pfCell_51 = BV18 (20 columns wide)
pfCell_52 = CP18 (11 columns wide)
pfCell_53 = V19 (20 columns wide)
pfCell_54 = AP19 (11 columns wide)
pfCell_55 = BV19 (20 columns wide)
pfCell_56 = CP19 (11 columns wide)
pfCell_57 = M20 (92 columns wide)
pfCell_58 = M21 (92 columns wide)
pfCell_59 = A9 (8 columns wide)
pfCell_60 = I9 (4 columns wide)
pfCell_61 = M9 (31 columns wide)
pfCell_62 = AR9 (9 columns wide)
pfCell_63 = BA9 (8 columns wide)
pfCell_64 = BI9 (4 columns wide)
pfCell_65 = BM9 (31 columns wide)
pfCell_66 = CR9 (9 columns wide)
pfCell_67 = AE24 (13 columns wide)
pfCell_68 = Q24 (14 columns wide)
pfCell_69 = Q26 (14 columns wide)
pfCell_70 = A24 (16 columns wide)
pfCell_71 = BZ26 (27 columns wide)
pfCell_72 = A26 (16 columns wide)
pfCell_73 = AE26 (13 columns wide)
pfCell_74 = CB25 (25 columns wide)
pfCell_75 = AR24 (13 columns wide)
pfCell_76 = BE24 (15 columns wide)
pfCell_77 = CE24 (22 columns wide)
pfCell_78 = Q28 (88 columns wide-merged)
pfCell_79 = Q29 (88 columns wide-merged)
pfCell_80 = Q30 (88 columns wide-merged)

As you can see, the named ranges are all over the place!

The CustList sheet was set-up for data storage and retrieval. The
Print_Form sheet was set-up as a visual record to be printed and
stored as a hard copy back-up. It was based on a legacy form that we
have been using for 33 years (not computer generated). I was more
concerned with the people taking down the information not getting
confused with a totally different looking form and not knowing where
to put the information and what new information to ask for from new
customers as they called in for the first time on the phone.

If this is not enough information, feel free to ask for more.

I really appreciated your taking a look at my problem.

-Minitman



On Sun, 15 Jun 2008 20:26:15 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

I think it might be a good idea to describe these ranges for us. The
reason
I suggest that is if you were processing your Print_From sheet by simple
columns (as you did on your Cust_Info sheet), then using similar column
ranges like my code does would seem to be a rather straight-forward
conversion process.

Rick

"Minitman" wrote in message
. ..
Thanks Rick,

You made a good assumption, which works for me.

I now need to migrate this code to a different sheet. This sheet
(Cust_Info) needs to look at columns. The new sheet (Print_Form)
needs to look at named ranges instead. I also posed this question to
Ron about his code. I don't see how to do this with either set of
code.

Is there a way?

If so, how?

Again, I want to thank you for taking the time to help, it is greatly
appreciated. Both you and Ron.

-Minitman



On Sun, 15 Jun 2008 15:37:41 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

You didn't say what you wanted to do for improper entries in Column 24,
so
I
returned the entry surrounded by <?? tags... you can change this by
modifying the code in the Case 24 statement block. Here is the code...

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"),
Range("AK:BD")))
_
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 Then
If UCase(Left(S, 3)) = "MAP" Then S = Mid(S, 4)
If Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
If S Like "###[a-zA-Z][a-zA-Z][a-zA-Z]##" Then
S = Format(S, "!Map @@@@ \<@@-@@\")
Else
S = "<??" & Target.Value & "<??"
End If
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
m...
Hey Rick,

Your code takes care of the pre formatted scenario, but not the bad
data scenario.

If I try to enter anything, the code will put as much of the data that
it can into the MapsCo format (Map #### <##-##) without regard as to
what the characters are (if I put two many characters in, it takes
only the last 8 characters, whatever they are). For the MapsCo format
the raw data needs to be three numbers then three alpha characters
followed by two numbers for a total of eight characters. This it will
format properly.

Is there a way to check for this?

-Minitman

On Sun, 15 Jun 2008 13:33:17 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

I just read your latest message to Ron about Column "X" values
possibly
being already formatted when entered. Here is my code which should
handle
that (and which contains the corrections previously posted), see if it
does
what you want...

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"),
Range("AK:BD")))
_
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 Then
If UCase(Left(S, 3)) = "MAP" Then S = Mid(S, 4)
If Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
S = Format(S, "!Map @@@@ \<@@-@@\")
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



"Rick Rothstein (MVP - VB)"
wrote
in
message ...
That Range("X") was supposed to have been Range("X:X"). Try changing
the
line to this and see if it works...

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"),
Range("AK:BD")))
_
Is Nothing Then Exit Sub

Rick


"Minitman" wrote in message
...
Good morning Rick,

Good to hear from you again.

There seems to be a problem with this code. It hangs up on the on
the
if statement at this place:


With the error message:

Run-time error '1004':
Method 'Range" of object '_Worksheet' failed

Debug highlighted this line:

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X"),
Range("AK:BD"))) _
Is Nothing Then Exit Sub

Breaking up this line at the 'Or's, I was able to eliminate all but
this code snippet:

...Union(Range("S:V"), Range("X"), Range("AK:BD"))...

Which looks good to me but not to debug.

I'm not sure if I did this elimination process right or not, but
that
was all I could think of to try.

Other then that, I got no further.

Is there an easy fix?

Please let me know.

Thanks.

-Minitman


On Sun, 15 Jun 2008 05:44:57 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

Going back to my construction... does this do what you want?

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X"),
Range("AK:BD")))
_
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 And Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then
Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
S = Format(S, "!Map @@@@ \<@@-@@\")
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
news:f7d954918l80a5p6kv1aulha5ctbctiaf3@4 ax.com...
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

Minitman
Remove Alpha Characters
 
I hope setup this works for you. I thought it might be easier to cut
and paste in a split up single column (text editor restrictions)

1st set is for the MapsCo Formatted cell:
pfCell_24

2nd set for telephone numbers:
pfCell_19
pfCell_21
pfCell_37
pfCell_39
pfCell_41
pfCell_43
pfCell_45
pfCell_47
pfCell_49
pfCell_51
pfCell_53
pfCell_55

3rd set for telephone extension numbers:
pfCell_20
pfCell_22
pfCell_38
pfCell_40
pfCell_42
pfCell_44
pfCell_46
pfCell_48
pfCell_50
pfCell_52
pfCell_54
pfCell_56


On Mon, 16 Jun 2008 00:15:37 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

Well, you gave me more information than I was expecting (I didn't need the
print layout stuff, but it did give me a sense of what you have to deal
with, so it was not a total loss). I'm glad to see your named ranges are
for single cells... I was half afraid we might be talking about rectangular
regions. Okay, to relate the previously posted code to this sheet, I need to
know which named ranges correspond to the 3 grouping (that is, MapsCo
Formatting, Telephone format and Extension format)... perhaps a 3-column
listing.

Rick


"Minitman" wrote in message
.. .
Fair enough.

It is a form most of the rows are 17 points in height and the columns
are .44 points wide. This comes out to 30 rows by 104 columns.

I originally set this up for merged cells. Then I saw the light and
unmerged all but 4, (they are memo fields and cover 88 columns by one
row, which is 66 points high. The format of these memo field is set
to top left with word wrap on at text size of 12. Giving me about 5
lines of word wrapped text which will only wrap inside a cell thus the
need to merge each memo field).

Here is a list of locations of the named ranges (note: the 'columns
wide' figures are the named range + the blank spaces needed to format
them with "Centered Across Selection to give the same effect as merged
cells gave without the special care needed in vba to handle merged
cells)":

pfCell_2 = T7 (36 columns wide)
pfCell_3 = A12 (52 columns wide)
pfCell_4 = BA12 (52 columns wide)
pfCell_5 = CU4 (-7 columns wide)
pfCell_6 = CV4 (5 columns wide)
pfCell_7 = R3 (8 columns wide)
pfCell_8 = CZ7 (10 columns wide)
pfCell_9 = CZ6 (10 columns wide)
pfCell_10 = CZ5 (10 columns wide)
pfCell_11 = A10 (52 columns wide)
pfCell_12 = A11 (27 columns wide)
pfCell_13 = AB11 (11 columns wide)
pfCell_14 = AM11 (14 columns wide)
pfCell_15 = BA10 (52 columns wide)
pfCell_16 = BA11 (27 columns wide)
pfCell_17 = CB11 (11 columns wide)
pfCell_18 = CM11 (14 columns wide)
pfCell_19 = V14 (20 columns wide)
pfCell_20 = AP14 (11 columns wide)
pfCell_21 = BV14 (20 columns wide)
pfCell_22 = CP14 (11 columns wide)
pfCell_23 = Q27 (88 columns wide-merged)
pfCell_24 = AR26 (28 columns wide)
pfCell_25 = BJ3 (12 columns wide)
pfCell_26 = AL3 (12 columns wide)
pfCell_27 = CO3 (12 columns wide)
pfCell_28 = T4 (9 columns wide)
pfCell_29 = AC4 (21 columns wide)
pfCell_30 = AX4 (23 columns wide)
pfCell_31 = BU4 (9 columns wide)
pfCell_32 = T5 (9 columns wide)
pfCell_33 = AC5 (21 columns wide)
pfCell_34 = AX5 (23 columns wide)
pfCell_35 = BU5 (9 columns wide)
pfCell_36 = T6 (62 columns wide)
pfCell_37 = V15 (20 columns wide)
pfCell_38 = AP15 (11 columns wide)
pfCell_39 = V16 (20 columns wide)
pfCell_40 = AP16 (11 columns wide)
pfCell_41 = BV15 (20 columns wide)
pfCell_42 = CP15 (11 columns wide)
pfCell_43 = BV16 (20 columns wide)
pfCell_44 = CP16 (11 columns wide)
pfCell_45 = V17 (20 columns wide)
pfCell_46 = AP17 (11 columns wide)
pfCell_47 = BV17 (20 columns wide)
pfCell_48 = CP17 (11 columns wide)
pfCell_49 = V18 (20 columns wide)
pfCell_50 = AP18 (11 columns wide)
pfCell_51 = BV18 (20 columns wide)
pfCell_52 = CP18 (11 columns wide)
pfCell_53 = V19 (20 columns wide)
pfCell_54 = AP19 (11 columns wide)
pfCell_55 = BV19 (20 columns wide)
pfCell_56 = CP19 (11 columns wide)
pfCell_57 = M20 (92 columns wide)
pfCell_58 = M21 (92 columns wide)
pfCell_59 = A9 (8 columns wide)
pfCell_60 = I9 (4 columns wide)
pfCell_61 = M9 (31 columns wide)
pfCell_62 = AR9 (9 columns wide)
pfCell_63 = BA9 (8 columns wide)
pfCell_64 = BI9 (4 columns wide)
pfCell_65 = BM9 (31 columns wide)
pfCell_66 = CR9 (9 columns wide)
pfCell_67 = AE24 (13 columns wide)
pfCell_68 = Q24 (14 columns wide)
pfCell_69 = Q26 (14 columns wide)
pfCell_70 = A24 (16 columns wide)
pfCell_71 = BZ26 (27 columns wide)
pfCell_72 = A26 (16 columns wide)
pfCell_73 = AE26 (13 columns wide)
pfCell_74 = CB25 (25 columns wide)
pfCell_75 = AR24 (13 columns wide)
pfCell_76 = BE24 (15 columns wide)
pfCell_77 = CE24 (22 columns wide)
pfCell_78 = Q28 (88 columns wide-merged)
pfCell_79 = Q29 (88 columns wide-merged)
pfCell_80 = Q30 (88 columns wide-merged)

As you can see, the named ranges are all over the place!

The CustList sheet was set-up for data storage and retrieval. The
Print_Form sheet was set-up as a visual record to be printed and
stored as a hard copy back-up. It was based on a legacy form that we
have been using for 33 years (not computer generated). I was more
concerned with the people taking down the information not getting
confused with a totally different looking form and not knowing where
to put the information and what new information to ask for from new
customers as they called in for the first time on the phone.

If this is not enough information, feel free to ask for more.

I really appreciated your taking a look at my problem.

-Minitman



On Sun, 15 Jun 2008 20:26:15 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

I think it might be a good idea to describe these ranges for us. The
reason
I suggest that is if you were processing your Print_From sheet by simple
columns (as you did on your Cust_Info sheet), then using similar column
ranges like my code does would seem to be a rather straight-forward
conversion process.

Rick

"Minitman" wrote in message
...
Thanks Rick,

You made a good assumption, which works for me.

I now need to migrate this code to a different sheet. This sheet
(Cust_Info) needs to look at columns. The new sheet (Print_Form)
needs to look at named ranges instead. I also posed this question to
Ron about his code. I don't see how to do this with either set of
code.

Is there a way?

If so, how?

Again, I want to thank you for taking the time to help, it is greatly
appreciated. Both you and Ron.

-Minitman



On Sun, 15 Jun 2008 15:37:41 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

You didn't say what you wanted to do for improper entries in Column 24,
so
I
returned the entry surrounded by <?? tags... you can change this by
modifying the code in the Case 24 statement block. Here is the code...

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"),
Range("AK:BD")))
_
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 Then
If UCase(Left(S, 3)) = "MAP" Then S = Mid(S, 4)
If Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
If S Like "###[a-zA-Z][a-zA-Z][a-zA-Z]##" Then
S = Format(S, "!Map @@@@ \<@@-@@\")
Else
S = "<??" & Target.Value & "<??"
End If
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
om...
Hey Rick,

Your code takes care of the pre formatted scenario, but not the bad
data scenario.

If I try to enter anything, the code will put as much of the data that
it can into the MapsCo format (Map #### <##-##) without regard as to
what the characters are (if I put two many characters in, it takes
only the last 8 characters, whatever they are). For the MapsCo format
the raw data needs to be three numbers then three alpha characters
followed by two numbers for a total of eight characters. This it will
format properly.

Is there a way to check for this?

-Minitman

On Sun, 15 Jun 2008 13:33:17 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

I just read your latest message to Ron about Column "X" values
possibly
being already formatted when entered. Here is my code which should
handle
that (and which contains the corrections previously posted), see if it
does
what you want...

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"),
Range("AK:BD")))
_
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 Then
If UCase(Left(S, 3)) = "MAP" Then S = Mid(S, 4)
If Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
S = Format(S, "!Map @@@@ \<@@-@@\")
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



"Rick Rothstein (MVP - VB)"
wrote
in
message ...
That Range("X") was supposed to have been Range("X:X"). Try changing
the
line to this and see if it works...

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"),
Range("AK:BD")))
_
Is Nothing Then Exit Sub

Rick


"Minitman" wrote in message
...
Good morning Rick,

Good to hear from you again.

There seems to be a problem with this code. It hangs up on the on
the
if statement at this place:


With the error message:

Run-time error '1004':
Method 'Range" of object '_Worksheet' failed

Debug highlighted this line:

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X"),
Range("AK:BD"))) _
Is Nothing Then Exit Sub

Breaking up this line at the 'Or's, I was able to eliminate all but
this code snippet:

...Union(Range("S:V"), Range("X"), Range("AK:BD"))...

Which looks good to me but not to debug.

I'm not sure if I did this elimination process right or not, but
that
was all I could think of to try.

Other then that, I got no further.

Is there an easy fix?

Please let me know.

Thanks.

-Minitman


On Sun, 15 Jun 2008 05:44:57 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

Going back to my construction... does this do what you want?

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X"),
Range("AK:BD")))
_
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 And Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then
Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
S = Format(S, "!Map @@@@ \<@@-@@\")
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
news:f7d954918l80a5p6kv1aulha5ctbctiaf3@ 4ax.com...
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

Rick Rothstein \(MVP - VB\)[_2133_]
Remove Alpha Characters
 
That setup was fine. Give this Worksheet Change event procedure (for the
Print_Form sheet) a try and see if it does what you want...

Private Sub Worksheet_Change(ByVal Target As Range)
Dim X As Long
Dim S As String
Dim Types(1 To 3) As Range

' MapsCo Format
Set Types(1) = Range("pfCell_24")
' Telephone format
Set Types(2) = Union(Range("pfCell_19"), Range("pfCell_21"))
For X = 37 To 55 Step 2
Set Types(2) = Union(Types(2), Range("pfCell_" & X))
Next
' Extension format
Set Types(3) = Union(Range("pfCell_20"), Range("pfCell_22"))
For X = 38 To 56 Step 2
Set Types(3) = Union(Types(3), Range("pfCell_" & X))
Next

S = Target.Value
If Target.Count 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("pfCell_19:pfCell_22"), _
Range("pfCell_24:pfCell_24"), _
Range("pfCell_37:pfCell_56"))) _
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Address = Range("pfCell_24").Address Then
If UCase(Left(S, 3)) = "MAP" Then S = Mid(S, 4)
If Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

For X = 1 To 3
If Not Intersect(Target, Types(X)) Is Nothing Then Exit For
Next
Select Case X
Case 1 'MapsCo Formatting
If S Like "###[a-zA-Z][a-zA-Z][a-zA-Z]##" Then
S = Format(S, "!Map @@@@ \<@@-@@\")
Else
S = "<??" & Target.Value & "<??"
End If
Case 2 '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 3 '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
...
I hope setup this works for you. I thought it might be easier to cut
and paste in a split up single column (text editor restrictions)

1st set is for the MapsCo Formatted cell:
pfCell_24

2nd set for telephone numbers:
pfCell_19
pfCell_21
pfCell_37
pfCell_39
pfCell_41
pfCell_43
pfCell_45
pfCell_47
pfCell_49
pfCell_51
pfCell_53
pfCell_55

3rd set for telephone extension numbers:
pfCell_20
pfCell_22
pfCell_38
pfCell_40
pfCell_42
pfCell_44
pfCell_46
pfCell_48
pfCell_50
pfCell_52
pfCell_54
pfCell_56


On Mon, 16 Jun 2008 00:15:37 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

Well, you gave me more information than I was expecting (I didn't need the
print layout stuff, but it did give me a sense of what you have to deal
with, so it was not a total loss). I'm glad to see your named ranges are
for single cells... I was half afraid we might be talking about
rectangular
regions. Okay, to relate the previously posted code to this sheet, I need
to
know which named ranges correspond to the 3 grouping (that is, MapsCo
Formatting, Telephone format and Extension format)... perhaps a 3-column
listing.

Rick


"Minitman" wrote in message
. ..
Fair enough.

It is a form most of the rows are 17 points in height and the columns
are .44 points wide. This comes out to 30 rows by 104 columns.

I originally set this up for merged cells. Then I saw the light and
unmerged all but 4, (they are memo fields and cover 88 columns by one
row, which is 66 points high. The format of these memo field is set
to top left with word wrap on at text size of 12. Giving me about 5
lines of word wrapped text which will only wrap inside a cell thus the
need to merge each memo field).

Here is a list of locations of the named ranges (note: the 'columns
wide' figures are the named range + the blank spaces needed to format
them with "Centered Across Selection to give the same effect as merged
cells gave without the special care needed in vba to handle merged
cells)":

pfCell_2 = T7 (36 columns wide)
pfCell_3 = A12 (52 columns wide)
pfCell_4 = BA12 (52 columns wide)
pfCell_5 = CU4 (-7 columns wide)
pfCell_6 = CV4 (5 columns wide)
pfCell_7 = R3 (8 columns wide)
pfCell_8 = CZ7 (10 columns wide)
pfCell_9 = CZ6 (10 columns wide)
pfCell_10 = CZ5 (10 columns wide)
pfCell_11 = A10 (52 columns wide)
pfCell_12 = A11 (27 columns wide)
pfCell_13 = AB11 (11 columns wide)
pfCell_14 = AM11 (14 columns wide)
pfCell_15 = BA10 (52 columns wide)
pfCell_16 = BA11 (27 columns wide)
pfCell_17 = CB11 (11 columns wide)
pfCell_18 = CM11 (14 columns wide)
pfCell_19 = V14 (20 columns wide)
pfCell_20 = AP14 (11 columns wide)
pfCell_21 = BV14 (20 columns wide)
pfCell_22 = CP14 (11 columns wide)
pfCell_23 = Q27 (88 columns wide-merged)
pfCell_24 = AR26 (28 columns wide)
pfCell_25 = BJ3 (12 columns wide)
pfCell_26 = AL3 (12 columns wide)
pfCell_27 = CO3 (12 columns wide)
pfCell_28 = T4 (9 columns wide)
pfCell_29 = AC4 (21 columns wide)
pfCell_30 = AX4 (23 columns wide)
pfCell_31 = BU4 (9 columns wide)
pfCell_32 = T5 (9 columns wide)
pfCell_33 = AC5 (21 columns wide)
pfCell_34 = AX5 (23 columns wide)
pfCell_35 = BU5 (9 columns wide)
pfCell_36 = T6 (62 columns wide)
pfCell_37 = V15 (20 columns wide)
pfCell_38 = AP15 (11 columns wide)
pfCell_39 = V16 (20 columns wide)
pfCell_40 = AP16 (11 columns wide)
pfCell_41 = BV15 (20 columns wide)
pfCell_42 = CP15 (11 columns wide)
pfCell_43 = BV16 (20 columns wide)
pfCell_44 = CP16 (11 columns wide)
pfCell_45 = V17 (20 columns wide)
pfCell_46 = AP17 (11 columns wide)
pfCell_47 = BV17 (20 columns wide)
pfCell_48 = CP17 (11 columns wide)
pfCell_49 = V18 (20 columns wide)
pfCell_50 = AP18 (11 columns wide)
pfCell_51 = BV18 (20 columns wide)
pfCell_52 = CP18 (11 columns wide)
pfCell_53 = V19 (20 columns wide)
pfCell_54 = AP19 (11 columns wide)
pfCell_55 = BV19 (20 columns wide)
pfCell_56 = CP19 (11 columns wide)
pfCell_57 = M20 (92 columns wide)
pfCell_58 = M21 (92 columns wide)
pfCell_59 = A9 (8 columns wide)
pfCell_60 = I9 (4 columns wide)
pfCell_61 = M9 (31 columns wide)
pfCell_62 = AR9 (9 columns wide)
pfCell_63 = BA9 (8 columns wide)
pfCell_64 = BI9 (4 columns wide)
pfCell_65 = BM9 (31 columns wide)
pfCell_66 = CR9 (9 columns wide)
pfCell_67 = AE24 (13 columns wide)
pfCell_68 = Q24 (14 columns wide)
pfCell_69 = Q26 (14 columns wide)
pfCell_70 = A24 (16 columns wide)
pfCell_71 = BZ26 (27 columns wide)
pfCell_72 = A26 (16 columns wide)
pfCell_73 = AE26 (13 columns wide)
pfCell_74 = CB25 (25 columns wide)
pfCell_75 = AR24 (13 columns wide)
pfCell_76 = BE24 (15 columns wide)
pfCell_77 = CE24 (22 columns wide)
pfCell_78 = Q28 (88 columns wide-merged)
pfCell_79 = Q29 (88 columns wide-merged)
pfCell_80 = Q30 (88 columns wide-merged)

As you can see, the named ranges are all over the place!

The CustList sheet was set-up for data storage and retrieval. The
Print_Form sheet was set-up as a visual record to be printed and
stored as a hard copy back-up. It was based on a legacy form that we
have been using for 33 years (not computer generated). I was more
concerned with the people taking down the information not getting
confused with a totally different looking form and not knowing where
to put the information and what new information to ask for from new
customers as they called in for the first time on the phone.

If this is not enough information, feel free to ask for more.

I really appreciated your taking a look at my problem.

-Minitman



On Sun, 15 Jun 2008 20:26:15 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

I think it might be a good idea to describe these ranges for us. The
reason
I suggest that is if you were processing your Print_From sheet by simple
columns (as you did on your Cust_Info sheet), then using similar column
ranges like my code does would seem to be a rather straight-forward
conversion process.

Rick

"Minitman" wrote in message
m...
Thanks Rick,

You made a good assumption, which works for me.

I now need to migrate this code to a different sheet. This sheet
(Cust_Info) needs to look at columns. The new sheet (Print_Form)
needs to look at named ranges instead. I also posed this question to
Ron about his code. I don't see how to do this with either set of
code.

Is there a way?

If so, how?

Again, I want to thank you for taking the time to help, it is greatly
appreciated. Both you and Ron.

-Minitman



On Sun, 15 Jun 2008 15:37:41 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

You didn't say what you wanted to do for improper entries in Column
24,
so
I
returned the entry surrounded by <?? tags... you can change this by
modifying the code in the Case 24 statement block. Here is the code...

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"),
Range("AK:BD")))
_
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 Then
If UCase(Left(S, 3)) = "MAP" Then S = Mid(S, 4)
If Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
If S Like "###[a-zA-Z][a-zA-Z][a-zA-Z]##" Then
S = Format(S, "!Map @@@@ \<@@-@@\")
Else
S = "<??" & Target.Value & "<??"
End If
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
news:94pa549g2lt96n45oigft4iualak6nt29j@4ax. com...
Hey Rick,

Your code takes care of the pre formatted scenario, but not the bad
data scenario.

If I try to enter anything, the code will put as much of the data
that
it can into the MapsCo format (Map #### <##-##) without regard as
to
what the characters are (if I put two many characters in, it takes
only the last 8 characters, whatever they are). For the MapsCo
format
the raw data needs to be three numbers then three alpha characters
followed by two numbers for a total of eight characters. This it
will
format properly.

Is there a way to check for this?

-Minitman

On Sun, 15 Jun 2008 13:33:17 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

I just read your latest message to Ron about Column "X" values
possibly
being already formatted when entered. Here is my code which should
handle
that (and which contains the corrections previously posted), see if
it
does
what you want...

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"),
Range("AK:BD")))
_
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 Then
If UCase(Left(S, 3)) = "MAP" Then S = Mid(S, 4)
If Mid(S, X, 1) Like "[!0-9a-zA-Z]" Then Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
S = Format(S, "!Map @@@@ \<@@-@@\")
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



"Rick Rothstein (MVP - VB)"
wrote
in
message ...
That Range("X") was supposed to have been Range("X:X"). Try
changing
the
line to this and see if it works...

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X:X"),
Range("AK:BD")))
_
Is Nothing Then Exit Sub

Rick


"Minitman" wrote in message
...
Good morning Rick,

Good to hear from you again.

There seems to be a problem with this code. It hangs up on the
on
the
if statement at this place:


With the error message:

Run-time error '1004':
Method 'Range" of object '_Worksheet' failed

Debug highlighted this line:

If Target.Count 1 Or Target.Row = 1 Or Len(S) = 0 Or _
Intersect(Target, Union(Range("S:V"), Range("X"),
Range("AK:BD"))) _
Is Nothing Then Exit Sub

Breaking up this line at the 'Or's, I was able to eliminate all
but
this code snippet:

...Union(Range("S:V"), Range("X"), Range("AK:BD"))...

Which looks good to me but not to debug.

I'm not sure if I did this elimination process right or not, but
that
was all I could think of to try.

Other then that, I got no further.

Is there an easy fix?

Please let me know.

Thanks.

-Minitman


On Sun, 15 Jun 2008 05:44:57 -0400, "Rick Rothstein \(MVP - VB\)"
wrote:

Going back to my construction... does this do what you want?

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 Or _
Intersect(Target, Union(Range("S:V"), Range("X"),
Range("AK:BD")))
_
Is Nothing Then Exit Sub
For X = 1 To Len(S)
If Target.Column = 24 And Mid(S, X, 1) Like "[!0-9a-zA-Z]"
Then
Mid(S, X, 1) = " "
ElseIf Mid(S, X, 1) Like "[!0-9]" Then
Mid(S, X, 1) = " "
End If
Next
S = Replace(S, " ", "")

Select Case Target.Column
Case 24 'MapsCo Formatting
S = Format(S, "!Map @@@@ \<@@-@@\")
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
news:f7d954918l80a5p6kv1aulha5ctbctiaf3 @4ax.com...
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

Ron Rosenfeld
Remove Alpha Characters
 
On Sun, 15 Jun 2008 18:25:50 -0500, Minitman
wrote:

Hey Ron,

Thanks again for all of the help. This seems to be working on the
customer info sheet.

I can't seem to get it to work on the print form sheet.

Is it possible to use this code with named ranges instead of columns?

If so, how?

-Minitman

Given what you posted to Rick for the locations of the named ranges referring
to the different types of values, mine modified, to use the names instead of
columns:

=======================================
Option Explicit
Option Compare Text
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
Dim str

Set rTel = Union(Range("pfCell_19"), Range("pfCell_21"), Range("pfCell_37"), _
Range("pfCell_39"), Range("pfCell_41"), Range("pfCell_43"), _
Range("pfCell_45"), Range("pfCell_47"), Range("pfCell_49"), _
Range("pfCell_51"), Range("pfCell_53"), Range("pfCell_55"))

Set rExt = Union(Range("pfCell_20"), Range("pfCell_22"), Range("pfCell_38"), _
Range("pfCell_40"), Range("pfCell_42"), Range("pfCell_44"), _
Range("pfCell_46"), Range("pfCell_48"), Range("pfCell_50"), _
Range("pfCell_52"), Range("pfCell_54"), Range("pfCell_56"))

Set rMapsCo = Range("pfCell_24")

If Not Intersect(Target, Union(rTel, rExt, rMapsCo)) Is Nothing Then
Application.EnableEvents = False
Set re = CreateObject("vbscript.regexp")
re.Global = True
re.IgnoreCase = True
For Each c In Target
If Not Intersect(c, rTel) Is Nothing _
And c.Row < 1 And Len(c.Value) 0 Then
re.Pattern = "\D+"
str = re.Replace(c.Value, "")
Select Case Len(str)
Case Is = 7, 10, 11
str = Right(str, 10)
c.Value = Application.WorksheetFunction.Text _
(str, "[<=9999999]###-####;(###) ###-####")
Case Else
c.Value = c.Value & " is an Invalid Phone Number"
End Select
End If
If Not Intersect(c, rExt) Is Nothing _
And c.Row < 1 And Len(c.Value) 0 Then
re.Pattern = "\D+"
c.Value = Format(re.Replace(c.Value, ""), """Ext. ""0")
End If
If Not Intersect(c, rMapsCo) Is Nothing _
And c.Row < 1 And Len(c.Value) 0 Then
re.Pattern = "^\D*" 'remove leading non-digits
str = re.Replace(c.Value, "")
re.Pattern = "[^0-9A-Z]" 'remove subsequent non-alphanumerics
str = re.Replace(str, "")
If str Like "###[A-Z][A-Z][A-Z]##" Then
c.Value = Format(str, "!Map @@@@ \<@@-@@\")
Else
c.Value = c.Value & " is an invalid map code"
End If
End If
Next c
Application.EnableEvents = True
End If
End Sub
===========================================
--ron

Minitman
Remove Alpha Characters
 
Dear Rick and Ron.

Thank you both very much for your help on this code.

I have learned a lot from both of you and both of your code solutions
work great, just differently (which is even better, showing such
different approaches opened my mind to greater possibilities.)

Both of your efforts are indeed very greatly appreciated.

Thank you.

-Minitman

Rick Rothstein \(MVP - VB\)[_2136_]
Remove Alpha Characters
 
Dear Rick and Ron.

Thank you both very much for your help on this code.

You are quite welcome! I'm glad we got everything resolved for you.

I have learned a lot from both of you and both of your code solutions
work great, just differently (which is even better, showing such
different approaches opened my mind to greater possibilities.)

That is one of the true beauties about newsgroups... to be able to see the
variety of solutions that are possible for any given problems and, for those
involving programming, the flexibility of the Visual Basic language itself.
You came to this newsgroup looking for a solution to your particular
problem... besides coming here to help out those I am able to, I come here
to look at the various solutions offered to questions posted here so that I
can learn new techniques and approaches... I find myself learning something
new about Excel and/or Visual Basic practically every day. These newsgroups
are a monumental resource for learning as well as for finding solutions to
problems.

Both of your efforts are indeed very greatly appreciated.

While I can't speak for other volunteers (although I doubt any would
disagree), you need to understand that I thoroughly enjoy being able to help
out in these newsgroups. Besides being able to help others out by tapping
into the skill-set I acquired during my working life (I've been retired for
a little while now), I also have a selfish motive as well. To me, the
various problems presented here are like a never-ending source of puzzles to
be solved... and I have always loved solving puzzles my whole life long...
so that just adds to the enjoyment of my helping out here.

Rick


Ron Rosenfeld
Remove Alpha Characters
 
On Mon, 16 Jun 2008 10:26:53 -0500, Minitman
wrote:

Dear Rick and Ron.

Thank you both very much for your help on this code.

I have learned a lot from both of you and both of your code solutions
work great, just differently (which is even better, showing such
different approaches opened my mind to greater possibilities.)

Both of your efforts are indeed very greatly appreciated.

Thank you.

-Minitman

You're most welcome. Glad to help.

And what Rick wrote goes for me, too. (He writes more elegantly than I, and
expresses my sentiments, also).
--ron


All times are GMT +1. The time now is 12:22 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com