Josh
Josh

Reputation: 167

Function to expand an array

How would I write a function that I can pass an array to and have it returned, but expanded by 1?

e.g.

myArray = expandArray(myArray)

Function expandArray(myArray As Long)
    Dim x As Integer
    x = UBound(myArray) + 1
    ReDim Preserve myArray(x)
    expandArray = myArray

End Function

I'm getting a ByRef error with the above

Upvotes: 3

Views: 302

Answers (2)

John Alexiou
John Alexiou

Reputation: 29244

First, see if a Collection object would do the job

Public Sub TestCollection()

    Dim arr As New Collection
    
    arr.Add 100
    arr.Add 200
    arr.Add 300
    
    Debug.Print arr(1)
    ' 100
    
    Call arr.Remove(1)

    Debug.Print arr(1)
    ' 200
    
End Sub

But what you cannot do with a collection is to write to cells like

Sheet1.Range("A2").Resize(arr.Count, 1).Value2 = arr
' Error

So if you need to expand an array then use the code below:

Public Sub TestExpandArray()
    Dim arr1() As Variant, arr2 As Variant
    
    arr1 = Array(100, 200, 300)
    arr2 = ExpandArray1(arr1, 2)
    ' result is 5 array
    
    Dim i As Long
    For i = LBound(arr2, 1) To UBound(arr2, 1)
        Debug.Print i, arr2(i)
    Next i
    
    ' Now test a 2D array from a range. The size is 5×7 for example.
    arr1 = Sheet1.Range("A2").Resize(5, 7).Value2
    
    arr2 = ExpandArray2(arr1, 1, 3)
    ' result is 6×10 array
    Debug.Print UBound(arr2, 1), UBound(arr2, 2)

End Sub

Public Function ExpandArray1(ByRef arr() As Variant, ByVal count As Long) As Variant()
    Dim i1 As Long, i2 As Long, i3 As Long
    i1 = LBound(arr, 1): i2 = UBound(arr, 1)
    i3 = i2 + count
    ReDim Preserve arr(i1 To i3)
    ExpandArray1 = arr
End Function

Public Function ExpandArray2(ByRef arr() As Variant, ByVal count1 As Long, ByVal count2 As Long) As Variant()
    Dim i1 As Long, i2 As Long, i3 As Long
    Dim j1 As Long, j2 As Long, j3 As Long
    i1 = LBound(arr, 1): i2 = UBound(arr, 1)
    j1 = LBound(arr, 2): j2 = UBound(arr, 2)
    i3 = i2 + count1: j3 = j2 + count2
    Dim res() As Variant
    ReDim res(i1 To i3, j1 To j3)
    For i3 = i1 To i2
        For j3 = j1 To j2
            res(i3, j3) = arr(i3, j3)
        Next j3
    Next i3
    ExpandArray2 = res
End Function

As you can see the code ExpandArray1 to expand a 1D array can use the Preserve keyword and it straight forward. But, the code ExpandArray2 to expand a 2D array cannot use Preserve and manual copying of data has to occur.

Upvotes: 1

Pᴇʜ
Pᴇʜ

Reputation: 57683

Force myArray to be an array and make it of type Variant. If you are sure your array only contains values of type Long then replace both Variant with Long.

Sub Test()
    Dim myOriginalArray()
    myOriginalArray = Array(1, 2, 3)

    Dim MyReturnedArray()
    MyReturnedArray = expandArray(myOriginalArray)
   
    'because of ByRef both myOriginalArray and MyReturnedArray got expanded
End Sub

Function expandArray(ByRef myArray() As Variant) As Variant
    Dim x As Long
    x = UBound(myArray) + 1
    ReDim Preserve myArray(x)
    expandArray = myArray
End Function

But note that you can only give the array ByRef which means that the myOriginalArray will get expanded too!

So it would be more clear to make it a procedure instead of a function

Sub Test()
    Dim myOriginalArray()
    myOriginalArray = Array(1, 2, 3)

    expandArray myOriginalArray 
    'the myOriginalArray got expanded because of ByRef
End Sub

Sub expandArray(ByRef myArray() As Variant)
    Dim x As Long
    x = UBound(myArray) + 1
    ReDim Preserve myArray(x)
End Function

Or if you need the myOriginalArray to not to change,

Sub Test()
    Dim myOriginalArray()
    myOriginalArray = Array(1, 2, 3)

    Dim MyReturnedArray()
    MyReturnedArray = expandArray(myOriginalArray)

    'here only MyReturnedArray is the expanded version
End Sub

Public Function expandArray(ByRef myArray() As Variant) As Variant
    Dim x As Long
    x = UBound(myArray) + 1
    
    Dim ReturnArray() As Variant
    ReturnArray = myArray 'make sure only the return array gets expanded even with ByRef
    
    ReDim Preserve ReturnArray(x)
    expandArray = ReturnArray
End Function

Final thoughts

Note that if you use ReDim Preserve a lot, this comes with a high cost and slows down your code a lot. Sometimes it is more efficient to define a larger array that has empty slots than re-sizing an array multiple times.

Upvotes: 4

Related Questions