Posters often ask how a sub array of a 2-D array can be created. I have
often referred to the SubArray function in the freely downloadable file
at
http://home.pacbell.net/beban. There follows some code that will
accomplish the same thing for a 2-D array that is not too large to fit
on a single worksheet (i.e., 65536x256); no add-in required. It
involves transferring the array to a worksheet, extracting the sub array
to a second worksheet by means of an array formula, and then writing the
sub array range to a VBA array. I have run *no* tests to explore speed
of execution.
Sub SubArrayFormula(InputArray, row1, row2, col1, col2)
Dim rng1 As Range, rng2 As Range,icol1 As Long, icol2 As Long
Dim MySubArray As Variant
Worksheets.Add
ActiveSheet.Name = "xyz1"
Set rng1 = Range("a1").Resize(UBound(InputArray) _
-LBound(InputArray) + 1, _
UBound(InputArray, 2) - LBound(InputArray, 2) + 1)
rng1.Value = InputArray
Worksheets.Add
ActiveSheet.Name = "xyz2"
Set rng2 = Range("A1").Resize(row2 - row1 + 1, col2 - col1 + 1)
Select Case col1
Case Is < 27
icol1 = Chr(64 + col1)
Case Is < 53
icol1 = "A" & Chr(64 + col1 - 26)
Case Is < 79
icol1 = "B" & Chr(64 + col1 - 52)
Case Is < 105
icol1 = "C" & Chr(64 + col1 - 78)
Case Is < 131
icol1 = "D" & Chr(64 + col1 - 104)
Case Is < 157
icol1 = "E" & Chr(64 + col1 - 130)
Case Is < 183
icol1 = "F" & Chr(64 + col1 - 156)
Case Is < 209
icol1 = "G" & Chr(64 + col1 - 182)
Case Is < 235
icol1 = "H" & Chr(64 + col1 - 208)
Case Is < 257
icol1 = "I" & Chr(64 + col1 - 234)
End Select
Select Case col2
Case Is < 27
icol2 = Chr(64 + col2)
Case Is < 53
icol2 = "A" & Chr(64 + col2 - 26)
Case Is < 79
icol2 = "B" & Chr(64 + col2 - 52)
Case Is < 105
icol2 = "C" & Chr(64 + col2 - 78)
Case Is < 131
icol2 = "D" & Chr(64 + col2 - 104)
Case Is < 157
icol2 = "E" & Chr(64 + col2 - 130)
Case Is < 183
icol2 = "F" & Chr(64 + col2 - 156)
Case Is < 209
icol2 = "G" & Chr(64 + col2 - 182)
Case Is < 235
icol2 = "H" & Chr(64 + col2 - 208)
Case Is < 257
icol2 = "I" & Chr(64 + col2 - 234)
End Select
rng2.FormulaArray = "=INDEX(xyz1!" & rng1.Address & _
",ROW(" & row1 & ":" & row2 & "),COLUMN(" & icol1 & ":" & _
icol2 & "))"
MySubArray = rng2.Value
Application.DisplayAlerts = False
Sheets("xyz1").Delete
Sheets("xyz2").Delete
Application.DisplayAlerts = True
End Sub
It arose out of exploring ways to return non-contiguous columns from a
VBA array.
Alan Beban