Disconnected Range to Variant

[Guest]

Option Explicit
Public Sub DisconectedRange()
Dim vArray As Variant
Dim WSRange As Range
Dim L1 As Integer, U1 As Integer, L2 As Integer, U2 As Integer

With ThisWorkbook.Worksheets(1)
Set WSRange = Union(.Range(.Cells(2, 1), .Cells(4, 1)),
..Range(.Cells(2, 6), .Cells(4, 6)))
End With
vArray = WSRange.Value 'Only seems to capture WSRange.Areas(1)

L1 = LBound(vArray, 1)
U1 = UBound(vArray, 1)
L2 = LBound(vArray, 2)
U2 = UBound(vArray, 2)

MsgBox CStr(L1) + "," + CStr(U1) + vbCrLf + CStr(L2) + "," + CStr(U2)
'Is there a way to pull in a disconnected range into a Variant?
End Sub

Thanks, Bob

 

[Alan Beban]

If the functions in the freely downloadable file at
http://home.pacbell.net/beban are available to your workbook:

Public Sub DisconectedRange()
Dim vArray As Variant
Dim WSRange As Range
Dim L1 As Integer, U1 As Integer, L2 As Integer, U2 As Integer

With ThisWorkbook.Worksheets(1)
Set rng1 = .Range(.Cells(2, 1), .Cells(4, 1))
Set rng2 = .Range(.Cells(2, 6), .Cells(4, 6))
'Set WSRange = Union(.Range(.Cells(2, 1), .Cells(4, 1)), _
'.Range(.Cells(2, 6), .Cells(4, 6)))
End With
'vArray = WSRange.Value 'Only seems to capture WSRange.Areas(1)
vArray = ArrayTranspose(MakeArray(rng1, rng2, 1))
L1 = LBound(vArray, 1)
U1 = UBound(vArray, 1)
L2 = LBound(vArray, 2)
U2 = UBound(vArray, 2)

MsgBox CStr(L1) + "," + CStr(U1) + vbCrLf + CStr(L2) + "," + CStr(U2)
'Is there a way to pull in a disconnected range into a Variant?
End Sub

Alan Beban

 

[Guest]

Thanks for your response Alan.

The problem is, I was looking to get the ranges extended out.

For example, if I put the ranges right next to each other, vArray has what I
want:

Option Explicit
Public Sub DisconectedRange()
Dim vArray As Variant
Dim WSRange As Range
Dim L1 As Integer, U1 As Integer, L2 As Integer, U2 As Integer

With ThisWorkbook.Worksheets(1)
Set WSRange = Union(.Range(.Cells(2, 1), .Cells(4, 1)),
.Range(.Cells(2, 2), .Cells(4, 2)))
End With
vArray = WSRange.Value 'Now this has what I want
L1 = LBound(vArray, 1)
U1 = UBound(vArray, 1)
L2 = LBound(vArray, 2)
U2 = UBound(vArray, 2)

MsgBox CStr(L1) + "," + CStr(U1) + vbCrLf + CStr(L2) + "," + CStr(U2)
End Sub

Fundementally, if I copied the ranges to another worksheet, but placed the
ranges next to each other, so that after the union you essentially get
..Range(.Cells(2, 1), .Cells(4, 2)), that is what I am looking for.

Bob

P.S. I only have Excel2000 at home, so any 2003 features I'll have to wait
till I get back to work.

 

[Alan Beban]

Then in what I sent you, instead of

vArray = ArrayTranspose(MakeArray(rng1, rng2, 1))

use

vArray = ArrayReshape(ArrayTranspose(MakeArray(rng1, rng2, 1)), 3, 2, 1)

Alan Beban

 

[Alan Beban]

Here's another way, which, too, depends on functions from the web site;
I didn't take the trouble to declare variables, but of course you should:

Sub abtest1()
Dim arr1()
ReDim arr1(1 To 3, 1 To 1)
With ThisWorkbook.Worksheets(1)
arr1 = .Range(.Cells(2, 1), .Cells(4, 2)).Value
arr2 = .Range(.Cells(2, 6), .Cells(4, 6)).Value
End With
'Add a second column of empty values to arr1
ReDim Preserve arr1(1 To 3, 1 To 2)
'Replace the second column of arr1 with the values from arr2
ReplaceSubArray arr1, arr2, 1, 2
End Sub

If the code is in a general module I would replace the 3rd thru 6th
lines with the following, which better suits my taste:

Set rng = ThisWorkbook.Worksheets(1).Range("A1")
arr1 = Range(rng(2, 1), rng(4, 2))
arr2 = Range(rng(2, 6), rng(4, 6))

I'm not a fan of the Cells Property, and in addition, the above avoids
the need for qualification if Worksheets(1) is not the active sheet.

Alan Beban