Remove WrapText

[Guest]

Hi,
I would like to remove WrapText for each each in range(A1:H400) that has a
named range. The fastest way should be to defined a range that contains only
the named range and then, I could apply rng.WrapText = False. Any idea?
Thanks!
Alex

 

[Peter T]

Hi Alex,

Sub test()
Dim rng As Range, rNm As Range, rWrp As Range
Dim ws As Worksheet
Dim nm As Name

Set ws = ActiveSheet
Set rng = ws.Range("A1:H400")

On Error Resume Next
For Each nm In ActiveWorkbook.Names
Set rNm = nm.RefersToRange
If Not rNm Is Nothing Then
If rNm.Parent Is ws Then
Set rWrp = Intersect(rng, rNm)
If Not rWrp Is Nothing Then
rWrp.WrapText = False
Set wrp = Nothing
End If
Set rNm = Nothing
End If
End If
Next
End Sub

Regards,
Peter T

 

[Guest]

Alex, try this:
Sub UnwrapNamedRange()
Dim r As Range
Dim r2 As Range
Dim nm As Name
Set r = Range("A1:H400")
For Each nm In ActiveWorkbook.Names
If Not Intersect(nm.RefersToRange, r) Is Nothing Then
If r2 Is Nothing Then
Set r2 = nm.RefersToRange
Else
Set r2 = Union(r2, nm.RefersToRange)
End If
End If
Next
r2.WrapText = False
End Sub

 

[Guest]

Here we "concatenate" or "unite" all the named ranges and then intersect:

Sub alex()
Set rlook = Nothing
For Each nm In ActiveWorkbook.Names
Set r = Range(nm.Name)
If rlook Is Nothing Then
Set rlook = r
Else
Set rlook = Union(rlook, r)
End If
Next

Set rlook = Intersect(rlook, Range("A1:H400"))
If rlook Is Nothing Then
Else
rlook.WrapText = False
End If
End Sub


just make sure you don't have any "special" named areas, or test out any
"special" named areas.

 

[Guest]

Sub ABC()
Dim nm As Name, rng As Range
Dim rng1 As Range, rng2 As Range
For Each nm In ThisWorkbook.Names
Set rng = Nothing
On Error Resume Next
Set rng = Evaluate(nm.Name)
On Error GoTo 0
If Not rng Is Nothing Then
If rng.Parent.Name = ActiveSheet.Name Then
Set rng1 = Nothing
Set rng1 = Intersect(rng, Range("A1:H400"))
If Not rng1 Is Nothing Then
If rng2 Is Nothing Then
Set rng2 = rng1
Else
Set rng2 = Union(rng2, rng1)
End If
End If
End If
End If
Next
If Not rng2 Is Nothing Then
rng2.WrapText = False
msgbox rng2.Address
End If

End Sub

 

[Guest]

something like this:

Sub UnWrap()
Dim n As Name
Dim rng As Range

On Error Resume Next
For Each n In ThisWorkbook.Names
Set rng = Intersect(n.RefersToRange, ActiveSheet.Range("A1:H400"))
If Not rng Is Nothing Then
rng.WrapText = False
End If
Set rng = Nothing
Next n

End Sub

 

[Guest]

Now that I posted, looks like there are a lot of posts.

All are pretty much the same. The reason mine seems somewhat verbose is

a. I check that the named range is actually a range - all are not. If it
isn't a range and you try to use it as a range, you get an error.
b. I Check that if it is a range, it is on the same sheet as A1:H400 - if
not, attempting an intersect will lead to an error. (Peter T also tested for
this)
c. I used Evaluate rather than RefersToRange because if a name contains a
large number of areas, it can cause an error when using RefersToRange. You
could also use Application.Range(nm.name) rather than evaluate.

Comments only provided for information for the OP, not as criticism.

 

[Guest]

Hi Peter,
I tested all program and the fastest depend on what you want.
1) If you need to unwrap all cells every time, it is faster to make an union
like Tom's or Gary(takes 0.18 seconds)
2) When I tried your program, it takes 0.3 seconds.

By making the following, your program takes only 0.05 seconds to run when
there's no wraptext to remove.
Replacing
rWrp.WrapText = False
By
If rWrp.WrapText = True Then
rWrp.WrapText = False
End If

Since the program I used don't have to remove wrap text every time you click
on the form, the option #2 is faster. The form open quite faster now!!
Thanks all

 

[Peter T]

A couple comments -

If rWrp.WrapText = True Then
rWrp.WrapText = False
End If

If the range is a single cell no problem, otherwise if there's a combination
of True/False in cells, rWrp.WrapText will return Null

v = rWrp.WrapText
then check for isnull and/or true

Concerning union vs individually, speed would very much relate to how many
unions you did and in particular how many non contiguous areas it made, up
to 1800 in your range of 3600 cells - that would be extremely slow without a
lot of additional code. Combine both methods and count rWrp.areas after each
union, then if more than say 100 clear that and start a new union.

Regards,
Peter T

 

[Peter T]

Not sure why I used RefersToRange, as you say it would fail if the address
length is close to 255 or more. Normally I use simply
set rng = Range(nmName)

FWIW my example also caters your point a) as well as b).

Regards,
Peter T