Redim Preserve VBA Alternatives

Question

Background
I just read a comment on this question that states that Redim Preserve is expensive and should be avoided. I use Redim Preserve in many scenarios, let us say for example to save field names from a PT that meet some specific criteria to use them later on with an API for Access/Selenium/XlWings,etc. where I need to access the elements in the array at different times, thus not looping in the original sheet(s) where PT(s) are; I use them to save data that came outside Excel too. This is to save the time to redo verification/processes and everything that was considered by saving the array in the first place.
Research/thoughts
I have seen that a similar question was asked at VB.net where they suggest List(Of Variable) but I do not think this may be achieved within Excel. I Erase them once they are not longer needed too. In addition, where it is possible, I try to use dictionaries instead of arrays, but it may not be always the case where it is easier to go by index numbers and there is a need for array and not dictionaries. I was thinking that I may be able to create a sheet with the specified items instead of saving them to an array, but I do not see the benefit of doing so in terms of memory saving.
Question
What would be the best alternative to Redim Preserve in VBA?

Answer 1

The intent of Ben's comment is that you should avoid excessive use of Preserve.

Where Arrays are a good design choice, you can and should use them. This is especially true when extracting data from an Excel sheet.

So, how to avoid excessive use of Preserve?

The need to Redim Preserve implies you are collecting data into an array, usually in a loop. Redim without Preserve is pretty fast.

1. If you have sufficient info, calculate the required array size and ReDim it as that size once
2. If you don't have that info, Redim it to an oversize dimension. Redim Preserve to the actual size once, after the loop
3. If you must Redim Preserve in the loop, do it infrequently in large chunks
4. Beware of premature optimisation. If it works fast enough for your needs, maybe just leave it as is

Answer 2

Update for 20 May 2022. An updated version of the class below can be found at

https://github.com/FullValueRider/WCollection

This update has a more extensive collection of methods and is also available as a 32 bit or 64 bit ActiveX.dll (thanks to twinBasic). There are currently 148 passing tests so the problems of things not working should hopefully be avoided.
Please leave any further comments or requests for updates as an issue on the github page.

===============================================

A collection is a good way to go but the default collection is a bit limited.

You may wish to use a wrapped collection which gives you more flexibility.

Class WCollection (but its easy to change the name to List if you prefer)

VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "WCollection"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
'Rubberduck annotations
'@PredeclaredId
'@Exposed
Option Explicit


'@ModuleDescription("A wrapper for the collection object to add flexibility")

Private Type State
    
    Coll                                        As Collection
    
End Type

Private s                                       As State

Private Sub Class_Initialize()
    Set s.Coll = New Collection
End Sub

Public Function Deb() As WCollection
    With New WCollection
        Set Deb = .ReadyToUseInstance
    End With
End Function


Friend Function ReadyToUseInstance() As WCollection
    Set ReadyToUseInstance = Me
End Function

Public Function NewEnum() As IEnumVARIANT
    Set NewEnum = s.Coll.[_NewEnum]
End Function

Public Function Add(ParamArray ipItems() As Variant) As WCollection
    Dim myItem As Variant
    For Each myItem In ipItems
        s.Coll.Add myItem
    Next
        Set Add = Me
End Function

Public Function AddRange(ByVal ipIterable As Variant) As WCollection
    Dim myitem As Variant
    For Each myitem In ipIterable
        s.Coll.Add myitem
    Next
    Set AddRange = Me
End Function


Public Function AddString(ByVal ipString As String) As WCollection
    Dim myIndex As Long
    For myIndex = 1 To Len(ipString)
        s.Coll.Add VBA.Mid$(ipString, myIndex, 1)
    Next
End Function


Public Function Clone() As WCollection
    Set Clone = WCollection.Deb.AddRange(s.Coll)
End Function
'@DefaultMember
Public Property Get Item(ByVal ipIndex As Long) As Variant
    If VBA.IsObject(s.Coll.Item(ipIndex)) Then
        Set Item = s.Coll.Item(ipIndex)
    Else
        Item = s.Coll.Item(ipIndex)
    End If
End Property

Public Property Let Item(ByVal ipIndex As Long, ByVal ipItem As Variant)
    s.Coll.Add ipItem, after:=ipIndex
    s.Coll.Remove ipIndex
End Property

Public Property Set Item(ByVal ipindex As Long, ByVal ipitem As Variant)
    s.Coll.Add ipitem, after:=ipindex
    s.Coll.Remove ipindex
End Property


Public Function HoldsItem(ByVal ipItem As Variant) As Boolean
    HoldsItem = True
    Dim myItem As Variant
    For Each myItem In s.Coll
        If myItem = ipItem Then Exit Function
    Next
    HoldsItem = False
End Function

Public Function Join(Optional ByVal ipSeparator As String) As String
    
    If TypeName(s.Coll.Item(1)) <> "String" Then
        Join = "Items are not string type"
        Exit Function
    End If
    
    Dim myStr As String
    Dim myItem As Variant
    For Each myItem In s.Coll
        If Len(myStr) = 0 Then
            myStr = myItem
        Else
            myStr = myStr & ipSeparator
        End If
        
    Next

End Function

Public Function Reverse() As WCollection
    Dim myW As WCollection
    Set myW = WCollection.Deb
    Dim myIndex As Long
    For myIndex = LastIndex To FirstIndex Step -1
        myW.Add s.Coll.Item(myIndex)
    Next
    Set Reverse = myW
End Function

Public Function HasItems() As Boolean
    HasItems = s.Coll.Count > 0
End Function

Public Function HasNoItems() As Boolean
    HasNoItems = Not HasItems
End Function

Public Function Indexof(ByVal ipItem As Variant, Optional ipIndex As Long = -1) As Long
    Dim myIndex As Long
    For myIndex = IIf(ipIndex = -1, 1, ipIndex) To s.Coll.Count
        If ipItem = s.Coll.Item(myIndex) Then
            Indexof = myIndex
            Exit Function
        End If
    Next
End Function

Public Function LastIndexof(ByVal ipItem As Variant, Optional ipIndex As Long = -1) As Long
    Dim myIndex As Long
    For myIndex = LastIndex To IIf(ipIndex = -1, 1, ipIndex) Step -1
        If ipItem = s.Coll.Item(myIndex) Then
            LastIndexof = myIndex
            Exit Function
        End If
    Next
    LastIndexof = -1
End Function

Public Function LacksItem(ByVal ipItem As Variant) As Boolean
    LacksItem = Not HoldsItem(ipItem)
End Function


Public Function Insert(ByVal ipIndex As Long, ByVal ipItem As Variant) As WCollection
    s.Coll.Add ipItem, before:=ipIndex
    Set Insert = Me
End Function


Public Function Remove(ByVal ipIndex As Long) As WCollection
    s.Coll.Remove ipIndex
    Set Remove = Me
End Function

Public Function FirstIndex() As Long
    FirstIndex = 1
End Function

Public Function LastIndex() As Long
    LastIndex = s.Coll.Count
End Function

Public Function RemoveAll() As WCollection
    Dim myIndex As Long
    For myIndex = s.Coll.Count To 1 Step -1
        Remove myIndex
    Next
    Set RemoveAll = Me
End Function


Public Property Get Count() As Long
    Count = s.Coll.Count
End Property

Public Function ToArray() As Variant
    Dim myarray As Variant
    ReDim myarray(0 To s.Coll.Count - 1)
    Dim myItem As Variant
    Dim myIndex As Long
    myIndex = 0
    For Each myItem In s.Coll
        If VBA.IsObject(myItem) Then
            Set myarray(myIndex) = myItem
        Else
            myarray(myIndex) = myItem
        End If
        myIndex = myIndex + 1
    Next
    ToArray = myarray
End Function

Public Function RemoveFirstOf(ByVal ipItem As Variant) As WCollection
    Set RemoveFirstOf = Remove(Indexof(ipItem))
    Set RemoveFirstOf = Me
End Function

Public Function RemoveLastOf(ByVal ipItem As Variant) As WCollection
    Set RemoveLastOf = Remove(LastIndexof(ipItem))
    Set RemoveLastOf = Me
End Function

Public Function RemoveAnyOf(ByVal ipItem As Variant) As WCollection
    Dim myIndex As Long
    For myIndex = LastIndex To FirstIndex Step -1
        
        If s.Coll.Item(myIndex) = ipItem Then Remove myIndex
        
    Next
    Set RemoveAnyOf = Me
End Function

Public Function First() As Variant
    If VBA.IsObject(s.Coll.Item(FirstIndex)) Then
        Set First = s.Coll.Item(FirstIndex)
    Else
        First = s.Coll.Item(FirstIndex)
    End If
End Function

Public Function Last() As Variant
    If VBA.IsObject(s.Coll.Item(LastIndex)) Then
        Set Last = s.Coll.Item(LastIndex)
    Else
        Last = s.Coll.Item(LastIndex)
    End If
End Function

Public Function Enqueue(ByVal ipItem As Variant) As WCollection
    Add ipItem
    Set Enqueue = Me
End Function

Public Function Dequeue() As Variant
    If VBA.IsObject(s.Coll.Item(FirstIndex)) Then
        Set Dequeue = s.Coll.Item(FirstIndex)
    Else
        Dequeue = s.Coll.Item(FirstIndex)
    End If
    Remove 0
End Function

Public Function Push(ByVal ipitem As Variant) As WCollection
    Add ipitem
    Set Push = Me
End Function

Public Function Pop(ByVal ipitem As Variant) As Variant
    If VBA.IsObject(s.Coll.Item(FirstIndex)) Then
        Set Pop = s.Coll.Item(FirstIndex)
    Else
        Pop = s.Coll.Item(FirstIndex)
    End If
    Remove s.Coll.Count
End Function

Public Function Peek(ByVal ipIndex As Long) As Variant
    If VBA.IsObject(s.Coll.Item(FirstIndex)) Then
        Set Peek = s.Coll.Item(FirstIndex)
    Else
        Peek = s.Coll.Item(FirstIndex)
    End If
End Function

Answer 3

The custom collection shown in another answer looks like a helpful tool. Another one I recently came across is the BetterArray class, found here. Rather than extending the built-in collection, it extends the built-in array. I posted an answer reviewing it and a couple of other options (the ArrayList, and expansion in chunks) here.

A Collection of Array Rows
One other approach is to use a 1d array for each row of data, and add rows into a collection. When done, the result can be dumped into a 2d array. With a function for making the conversion on hand, the process can be convenient and reasonably efficient.

Function ArrayFromRowCollection(source As Collection) As Variant
'Convert a collection of 1d array rows to a 2d array
'The return array will have the max number of columns found in any row (if inconsistent, a warning is printed)
'Any non-array values in the collection will be entered in the first column of the return array (with warning printed)
'Any objects or multidimensional arrays in the collection will cause an error

    Dim sourceCount As Long: sourceCount = source.Count
    If sourceCount > 0 Then
        'Scan for the max column count across all rows; wrap non-arrays in an array with a warning
        Dim itmRow As Variant, itmIndex As Long
        Dim arrayBound As Long, tempBound As Long, inconsistentBounds As Boolean
        For Each itmRow In source
            itmIndex = itmIndex + 1
            If VarType(itmRow) < vbArray Then 'An array has a vartype of at least the vbArray constant (8192)
                source.Add Array(itmRow), , itmIndex
                source.Remove itmIndex + 1 'Wrap non-array element in 1d array so it is in the expected format for later
                Debug.Print "ArrayFromRowCollection Warning: Non-array item found and entered in first array column (item " & itmIndex & ")"
            Else
                tempBound = UBound(itmRow)
                If arrayBound <> tempBound Then
                    If itmIndex > 1 Then inconsistentBounds = True 'This prompts a warning below
                    If tempBound > arrayBound Then arrayBound = tempBound 'Take the new larger bound, in search of the max
                End If
            End If
        Next
        If inconsistentBounds Then Debug.Print "ArrayFromRowCollection Warning: Inconsistent column counts found."
        
        'Create 2d array
        Dim i As Long, j As Long
        Dim returnArray() As Variant
        ReDim returnArray(sourceCount - 1, arrayBound)
        For Each itmRow In source
            For j = 0 To UBound(itmRow)
                returnArray(i, j) = itmRow(j)
            Next
            i = i + 1
        Next
        ArrayFromRowCollection = returnArray
    Else
        ArrayFromRowCollection = Array() 'Empty array for empty collection
    End If

End Function

A quick demo, creating an array of data from a directory.

Sub GatherDirectoryInfo()

    'Gather directory info in a collection of 1d array rows
    Dim tempDir As String, dirPath As String, tempFull As String
    dirPath = "C:" & Application.PathSeparator
    tempDir = Dir(dirPath, vbDirectory) 'This gets basic files and folders (just the first with this call)
    
    Dim tempCollection As Collection: Set tempCollection = New Collection
    tempCollection.Add Array("Parent Folder", "Name", "Type", "File Size", "Last Modified") 'Headers
    Do While tempDir <> ""
        tempFull = dirPath & tempDir
        tempCollection.Add Array(dirPath, tempDir, IIf(GetAttr(tempFull) And vbDirectory, "Folder", ""), Round(FileLen(tempFull) / 1024, 0) & " kb", FileDateTime(tempFull))
        tempDir = Dir()
    Loop
    
    'Transfer collection to 2d array
    Dim DirArray As Variant
    DirArray = ArrayFromRowCollection(tempCollection)

End Sub