Using the shape of the Range
Another approach in creating a function for ArrayFromRange would be using the shape and size of the Range to determine how we should structure the array. This way we don't have to load the data into an intermediate array to determine the dimension.
For instance, if the target range is only one cell, then we know we want to return an array with the single value in it Array(target.value).
Below is the complete function that should deal with all cases. Note, this uses the same technique of using the Application.Transpose method to reshape the array.
' Helper function that returns an array from a range with the
' correct dimensions. This fixes the issue of single values
' not returning as an array, and when a 2 dimension array is returned
' when it only has 1 dimension of data.
'
' @author Robert Todar <robert@roberttodar.com>
Public Function ArrayFromRange(ByVal target As Range) As Variant
Select Case True
' Single cell
Case target.Cells.Count = 1
ArrayFromRange = Array(target.Value)
' Single Row
Case target.Rows.Count = 1
ArrayFromRange = Application.Transpose( _
Application.Transpose(target.Value) _
)
' Single Column
Case target.Columns.Count = 1
ArrayFromRange = Application.Transpose(target.Value)
' Multi dimension array
Case Else
ArrayFromRange = target.Value
End Select
End Function
Testing the ArrayFromRange function
As a bonus, here are the tests that I ran to check that this function works.
' @requires {function} ArrayDimensionLength
' @requires {function} ArrayCount
Private Sub testArrayFromRange()
' Setup a new workbook/worksheet for
' adding testing data
Dim testWorkbook As Workbook
Set testWorkbook = Workbooks.Add
Dim ws As Worksheet
Set ws = testWorkbook.Worksheets(1)
' Add sample data for testing.
ws.Range("A1:A2") = Application.Transpose(Array("A1", "A2"))
ws.Range("B1:B2") = Application.Transpose(Array("B1", "B2"))
' This section will run all the tests.
Dim x As Variant
' Single cell
x = ArrayFromRange(ws.Range("A1"))
Debug.Assert ArrayDimensionLength(x) = 1
Debug.Assert ArrayCount(x) = 1
' Single Row
x = ArrayFromRange(ws.Range("A1:B1"))
Debug.Assert ArrayDimensionLength(x) = 1
Debug.Assert ArrayCount(x) = 2
' Single Column
x = ArrayFromRange(ws.Range("A1:A2"))
Debug.Assert ArrayDimensionLength(x) = 1
Debug.Assert ArrayCount(x) = 2
' Multi Column
x = ArrayFromRange(ws.Range("A1:B2"))
Debug.Assert ArrayDimensionLength(x) = 2
Debug.Assert ArrayCount(x) = 4
' Cleanup testing environment
testWorkbook.Close False
' Print result
Debug.Print "testArrayFromRange: PASS"
End Sub
Helper functions for the tests
In my tests I used two helper functions: ArrayCount, and ArrayDimensionLength. These are listed below for reference.
' Returns the length of the dimension of an array
'
' @author Robert Todar <robert@roberttodar.com>
Public Function ArrayDimensionLength(sourceArray As Variant) As Integer
On Error GoTo catch
Do
Dim currentDimension As Long
currentDimension = currentDimension + 1
' `test` is used to see when the
' Ubound throws an error. It is unused
' on purpose.
Dim test As Long
test = UBound(sourceArray, currentDimension)
Loop
catch:
' Need to subtract one because the last
' one errored out.
ArrayDimensionLength = currentDimension - 1
End Function
' Get count of elements in an array regardless of
' the option base. This Looks purely at the size
' of the array, not the contents within them such as
' empty elements.
'
' @author Robert Todar <robert@roberttodar.com>
' @requires {function} ArrayDimensionLength
Public Function ArrayCount(ByVal sourceArray As Variant) As Long
Dim dimensions As Long
dimensions = ArrayDimensionLength(sourceArray)
Select Case dimensions
Case 0
ArrayCount = 0
Case 1
ArrayCount = (UBound(sourceArray, 1) - LBound(sourceArray, 1)) + 1
Case Else
' Need to set arrayCount to 1 otherwise the
' loop will keep multiplying by zero for each
' iteration
ArrayCount = 1
Dim dimension As Long
For dimension = 1 To dimensions
ArrayCount = ArrayCount * _
((UBound(sourceArray, dimension) - LBound(sourceArray, dimension)) + 1)
Next
End Select
End Function
