I want to set a range variable with the address of
variable already set in another workbook. The problem is
if the address length is more than 256 (approx 17 to 25
areas).

The following seems to work, but the Loop & Union method
is slow with a very large number of areas.

Sub CopyRngVar()
Dim Rng1 As Range 'in active WB
Dim Rng2 As Range 'destined another WB
Dim a As Range

Set Rng1 = Range("A1:B3,A5:B6")

With Workbooks("Book2").Worksheets("Sheet1")

'this works if address length < 256
'Set Rng2 = .Range(Rng1.Address)

For Each a In Rng1.Areas
If Rng2 Is Nothing Then
Set Rng2 = .Range(a.Address)
Else
Set Rng2 = Union(Rng2, .Range(a.Address))
End If
Next

End With
Rng2.Interior.ColorIndex = 5

End Sub

Any ideas for a something more efficient much appreciated,
TIA,
Sandy

Savituk yahoo co uk

Seems like looping through the areas and setting the colors should be
relatively fast. (unless you need the rng2 reference set).


set sh = Workbooks("Book2.xls").Worksheest("Sheet1")
for each ar in rng1.Areas
sh.Range(ar.Address).Interior.ColorIndex = 5
Next

--
Regards,
Tom Ogilvy



"Sandy V" wrote in message
...
I want to set a range variable with the address of
variable already set in another workbook. The problem is
if the address length is more than 256 (approx 17 to 25
areas).

The following seems to work, but the Loop & Union method
is slow with a very large number of areas.

Sub CopyRngVar()
Dim Rng1 As Range 'in active WB
Dim Rng2 As Range 'destined another WB
Dim a As Range

Set Rng1 = Range("A1:B3,A5:B6")

With Workbooks("Book2").Worksheets("Sheet1")

'this works if address length < 256
'Set Rng2 = .Range(Rng1.Address)

For Each a In Rng1.Areas
If Rng2 Is Nothing Then
Set Rng2 = .Range(a.Address)
Else
Set Rng2 = Union(Rng2, .Range(a.Address))
End If
Next

End With
Rng2.Interior.ColorIndex = 5

End Sub

Any ideas for a something more efficient much appreciated,
TIA,
Sandy

Savituk yahoo co uk

Thanks Tom for replying.

Unfortunately I do need to set Rng2 with the address of
Rng1 for further manipulation in the second wb. The
colorindex bit in my example was purely to verify in the
test sub that Rng2 was correctly set (I should have
clarified that).

Ideally what I'd like to do is change the parent(s) of the
original variable (or a direct copy of it), which
obviously I can't. If the range contains say 500 areas,
my loop & union method is slow, especially when repeated a
few times.

Regards,
Sandy
savituk yahoo co uk

-----Original Message-----
Seems like looping through the areas and setting the
colors should be
relatively fast. (unless you need the rng2 reference set).


set sh = Workbooks("Book2.xls").Worksheest("Sheet1")
for each ar in rng1.Areas
sh.Range(ar.Address).Interior.ColorIndex = 5
Next

--
Regards,
Tom Ogilvy



"Sandy V" wrote in
message
...
I want to set a range variable with the address of
variable already set in another workbook. The problem is
if the address length is more than 256 (approx 17 to 25
areas).

The following seems to work, but the Loop & Union method
is slow with a very large number of areas.

Sub CopyRngVar()
Dim Rng1 As Range 'in active WB
Dim Rng2 As Range 'destined another WB
Dim a As Range

Set Rng1 = Range("A1:B3,A5:B6")

With Workbooks("Book2").Worksheets("Sheet1")

'this works if address length < 256
'Set Rng2 = .Range(Rng1.Address)

For Each a In Rng1.Areas
If Rng2 Is Nothing Then
Set Rng2 = .Range(a.Address)
Else
Set Rng2 = Union(Rng2, .Range(a.Address))
End If
Next

End With
Rng2.Interior.ColorIndex = 5

End Sub

Any ideas for a something more efficient much
appreciated,
TIA,
Sandy

Savituk yahoo co uk

A faster way doesn't come to mind. (given the limitations you cite)

--
Regards,
Tom Ogilvy

"Sandy V" wrote in message
...
Thanks Tom for replying.

Unfortunately I do need to set Rng2 with the address of
Rng1 for further manipulation in the second wb. The
colorindex bit in my example was purely to verify in the
test sub that Rng2 was correctly set (I should have
clarified that).

Ideally what I'd like to do is change the parent(s) of the
original variable (or a direct copy of it), which
obviously I can't. If the range contains say 500 areas,
my loop & union method is slow, especially when repeated a
few times.

Regards,
Sandy
savituk yahoo co uk

-----Original Message-----
Seems like looping through the areas and setting the
colors should be
relatively fast. (unless you need the rng2 reference set).


set sh = Workbooks("Book2.xls").Worksheest("Sheet1")
for each ar in rng1.Areas
sh.Range(ar.Address).Interior.ColorIndex = 5
Next

--
Regards,
Tom Ogilvy



"Sandy V" wrote in
message
...
I want to set a range variable with the address of
variable already set in another workbook. The problem is
if the address length is more than 256 (approx 17 to 25
areas).

The following seems to work, but the Loop & Union method
is slow with a very large number of areas.

Sub CopyRngVar()
Dim Rng1 As Range 'in active WB
Dim Rng2 As Range 'destined another WB
Dim a As Range

Set Rng1 = Range("A1:B3,A5:B6")

With Workbooks("Book2").Worksheets("Sheet1")

'this works if address length < 256
'Set Rng2 = .Range(Rng1.Address)

For Each a In Rng1.Areas
If Rng2 Is Nothing Then
Set Rng2 = .Range(a.Address)
Else
Set Rng2 = Union(Rng2, .Range(a.Address))
End If
Next

End With
Rng2.Interior.ColorIndex = 5

End Sub

Any ideas for a something more efficient much
appreciated,
TIA,
Sandy

Savituk yahoo co uk

Tom,

Although hopeful I wasn't very optimistic there would be,
but thanks for looking at it. Even a "no can do", or in
this case "nothing better" type response is appreciated -
stops me pursuing a lost cause!

Regards,
Sandy


-----Original Message-----
A faster way doesn't come to mind. (given the
limitations you cite)

--
Regards,
Tom Ogilvy

Snip

"Tom Ogilvy" wrote...
A faster way doesn't come to mind. (given the limitations you cite)
...

Accumulate multiple area ranges in 12-area chunks. Faster than one area at a
time, but only a constant factor speed-up.


Sub foo()
Dim i As Long, k As Long, n As Long, a As String
Dim r As Range

n = Selection.Areas.Count

For k = 1 To n Step 12
a = ""

For i = 0 To IIf(k + 12 n, n - k, 11)
a = a & "," & Selection.Areas(k + i).Address
Next i

a = Mid(a, 2)

If r Is Nothing Then
Set r = Range(a)

Else
Set r = Union(r, Range(a))

End If

Next k

MsgBox r.Areas.Count & Chr(13) & r.Cells.Count

End Sub

--
To top-post is human, to bottom-post and snip is sublime.

Thanks Harlan, that's great

Actually I was thinking along similar lines, but with a
different method.

I had noticed that Union of up to about 100 areas is
pretty quick, thereafter time increases exponentially.
What I am doing now is to Union 94* areas at a time into a
range array, then Union each of the array elements into a
single range.
(*94 seems about optimum)

In my ageing system I get these times with a sample of
1100 areas:

Simple Loop & Union per my original post: 19.7 sec
Chunks of 12 area strings: 2.04 sec
94 areas to array elements, then union all: 0.71 sec

Different samples might give different relative results.

If interested in the code drop me a line (I'll little tidy
it up a little).

Thanks again,
Sandy
savituk yahoo co uk

to top post seems to conform to the convention of this
NG <g

-----Original Message-----
"Tom Ogilvy" wrote...
A faster way doesn't come to mind. (given the
limitations you cite)
...

Accumulate multiple area ranges in 12-area chunks. Faster
than one area at a
time, but only a constant factor speed-up.


Sub foo()
Dim i As Long, k As Long, n As Long, a As String
Dim r As Range

n = Selection.Areas.Count

For k = 1 To n Step 12
a = ""

For i = 0 To IIf(k + 12 n, n - k, 11)
a = a & "," & Selection.Areas(k + i).Address
Next i

a = Mid(a, 2)

If r Is Nothing Then
Set r = Range(a)

Else
Set r = Union(r, Range(a))

End If

Next k

MsgBox r.Areas.Count & Chr(13) & r.Cells.Count

End Sub

--
To top-post is human, to bottom-post and snip is sublime.
.

Wow! This is scary. I don't get an error when setting a range to the
address of another that has a lot of areas, but the result is
incorrect. XL simply uses just enough areas to provide a address
string that is under 256 characters -- unf**king believable!

For example, in the code below, the statement
Set MimicARange = newSheet.Range(Rng1.Address)
simply sets MimicARange to mimic the first 21 areas of Rng1!

Any way, the workaround is to use the MimicARange function to do what
you want as shown in the testIt sub below.

Option Explicit

Function createTestRng(aWKS As Worksheet) As Range
Dim i As Integer
With aWKS
Set createTestRng = .Range("a1:b3")
For i = 2 To 50
Set createTestRng = Union(createTestRng, _
.Range("a" & (i - 1) * 5).Resize(2, 2))
Next i
End With
End Function
Function MimicARange(Rng1 As Range, newSheet As Worksheet) As Range
Dim i As Integer
If Rng1 Is Nothing Then Exit Function
On Error Resume Next
Set MimicARange = newSheet.Range(Rng1.Address)
On Error GoTo 0
If MimicARange.Areas.Count = Rng1.Areas.Count Then Exit Function
With newSheet
If MimicARange Is Nothing Then
Set MimicARange = .Range(Rng1.Areas(1).Address)
End If
For i = MimicARange.Areas.Count + 1 To Rng1.Areas.Count
Set MimicARange = Union(MimicARange, _
.Range(Rng1.Areas(i).Address))
Next i
End With
End Function
Sub testIt()
Dim i As Integer, Rng1 As Range, Rng2 As Range
Set Rng1 = createTestRng(ActiveWorkbook.Worksheets(1))
MsgBox Rng1.Parent.Name & ", " & Rng1.Areas.Count & ", " _
& Len(Rng1.Address) & ", " & Rng1.Address
Set Rng2 = MimicARange(Rng1, ActiveWorkbook.Worksheets(2))
MsgBox Rng2.Parent.Name & ", " & Rng2.Areas.Count & ", " _
& Len(Rng2.Address) & ", " & Rng2.Address
End Sub

--
Regards,

Tushar Mehta, MS MVP -- Excel
www.tushar-mehta.com
Excel, PowerPoint, and VBA add-ins, tutorials
Custom MS Office productivity solutions

In article ,
says...
I want to set a range variable with the address of
variable already set in another workbook. The problem is
if the address length is more than 256 (approx 17 to 25
areas).

The following seems to work, but the Loop & Union method
is slow with a very large number of areas.

Sub CopyRngVar()
Dim Rng1 As Range 'in active WB
Dim Rng2 As Range 'destined another WB
Dim a As Range

Set Rng1 = Range("A1:B3,A5:B6")

With Workbooks("Book2").Worksheets("Sheet1")

'this works if address length < 256
'Set Rng2 = .Range(Rng1.Address)

For Each a In Rng1.Areas
If Rng2 Is Nothing Then
Set Rng2 = .Range(a.Address)
Else
Set Rng2 = Union(Rng2, .Range(a.Address))
End If
Next

End With
Rng2.Interior.ColorIndex = 5

End Sub

Any ideas for a something more efficient much appreciated,
TIA,
Sandy

Savituk yahoo co uk