Remove Alpha Characters

[Rick Rothstein \(MVP - VB\)]

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

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

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

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

On Fri, 13 Jun 2008 19:14:02 -0500, Minitman
<[email protected]>
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]

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

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]

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

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

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

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



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

On Fri, 13 Jun 2008 19:14:02 -0500, Minitman
<[email protected]>
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\)]

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

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

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

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



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

On Fri, 13 Jun 2008 19:14:02 -0500, Minitman
<[email protected]>
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\)]

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

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

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

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\)"

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



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

On Fri, 13 Jun 2008 19:14:02 -0500, Minitman
<[email protected]>
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]

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

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

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

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\)"

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



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

On Fri, 13 Jun 2008 19:14:02 -0500, Minitman
<[email protected]>
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\)]

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

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

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

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


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\)"

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



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

On Fri, 13 Jun 2008 19:14:02 -0500, Minitman
<[email protected]>
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]

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]

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

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]

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

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

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

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



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


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\)"

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



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

On Fri, 13 Jun 2008 19:14:02 -0500, Minitman
<[email protected]>
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\)]

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

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

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

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\)"

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



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


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\)"

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



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

On Fri, 13 Jun 2008 19:14:02 -0500, Minitman
<[email protected]>
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]

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]

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

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

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

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



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\)"

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



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


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\)"

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



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

On Fri, 13 Jun 2008 19:14:02 -0500, Minitman
<[email protected]>
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\)]

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

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

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

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\)"

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



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\)"

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)" <[email protected]>
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


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\)"

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



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

On Fri, 13 Jun 2008 19:14:02 -0500, Minitman
<[email protected]>
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]

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

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

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

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

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\)"

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



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\)"

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)" <[email protected]>
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


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\)"

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



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

On Fri, 13 Jun 2008 19:14:02 -0500, Minitman
<[email protected]>
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\)]

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_19fCell_22"), _
Range("pfCell_24fCell_24"), _
Range("pfCell_37fCell_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

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

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

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\)"

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

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\)"

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



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\)"

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)" <[email protected]>
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


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\)"

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



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

On Fri, 13 Jun 2008 19:14:02 -0500, Minitman
<[email protected]>
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]

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]

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\)]

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]

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