Redim Preserve VBA Alternatives - arrays

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.
If you have sufficient info, calculate the required array size and ReDim it as that size once
If you don't have that info, Redim it to an oversize dimension. Redim Preserve to the actual size once, after the loop
If you must Redim Preserve in the loop, do it infrequently in large chunks
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