SortArrayColl.

Private Sub cmdArray_Click()
    StartTime = timeGetTime
    ReDim mArray(0 To 0) 'Always initialize 1 unused element 0 to avoid errors
    FoundIt = False
    For i = 1 To Max
    'Add a new item to the array
        'Find a blank slot
        For j = 1 To UBound(mArray, 1)
            If mArray(j).InUse = False Then
                'Found a blank slot - reuse it
                FoundIt = True
                Exit For
            End If
        Next j
        'If slot not found, create new one.
        If FoundIt = False Then
            'Allocate a new array slot
            j = UBound(mArray, 1) + 1
            ReDim Preserve mArray(0 To j)
        End If
        'Add item to slot
        mArray(j).InUse = True
        mArray(j).Value = i
    Next i
    For j = 1 To MaxModify
        For i = 1 To Max
            'Manipulate item in the array
            mArray(i).Value = i
        Next i
    Next j
    For i = 1 To Max
        'Remove item in the array
        mArray(i).InUse = False
    Next i
    lblArray.Caption = Format((timeGetTime - StartTime) / 1000, "#.00") & " seconds."
End Sub

Private Sub cmdCollection_Click()
    StartTime = timeGetTime
    Set mCol = New Collection
    'Add item to the collection
    For i = 1 To Max
        mCol.Add i
    Next i
    'Modify item in collection - can't modify, must remove and readd
    For j = 1 To MaxModify
        For i = 1 To Max
            mCol.Remove i
            mCol.Add i
        Next i
    Next j
    'Remove item from collection
    For i = 1 To Max
        mCol.Remove 1
    Next i
    lblCollection.Caption = Format((timeGetTime - StartTime) / 1000, "#.00") & " seconds."
End Sub

Private Sub cmdDictionary_Click()
    StartTime = timeGetTime
    Set mDict = New Dictionary
    'Add item to the dictionary
    For i = 1 To Max
        j = mDict.Count + 1
        mDict.Add j, i
    Next i
    'Modify item in the dictionary 500 times
    For j = 1 To MaxModify
        For i = 1 To Max
            mDict(i) = i
        Next i
    Next j
    'Remove item from the dictionary
    For i = 1 To Max
        mDict.Remove i
    Next i
    lblDictionary.Caption = Format((timeGetTime - StartTime) / 1000, "#.00") & " seconds."
End Sub

Private Sub Form_Load()
    Text1.Text = 500
    Text2.Text = 500
End Sub

Private Sub Text1_Change()
    Max = Val(Text1.Text)
End Sub

Private Sub Text2_Change()
    MaxModify = Val(Text2.Text)
End Sub
 This program tests array, collection, and dictionary speed.
It adds a user-specified number of items to the object being 
tested (array, collection, or dictionary), modifies all the 
items in the object maxModify times, then removes the object.
The total time it takes to perform all this, is timed, and 
displayed on-screen. Note that for a low number of 
modifications to the data, dictionaries appear best, but as 
you access or modify the data more, arrays clearly win out, 
even with the additional time up-front to find an empty 
array slot.

Option Explicit
Private Max As Long
Private MaxModify As Long
Private i As Long, j As Long
Private Type MyArrayType
InUse As Boolean
Value As Long
End Type
Private mArray() As MyArrayType
Private mCol As Collection
Private mDict As Dictionary
Private FoundIt As Boolean
Private StartTime As Long
Private Declare Function timeGetTime Lib "winmm.dll" () As Long

Private Sub cmdArray_Click()
StartTime = timeGetTime
ReDim mArray(0 To 0) 'Always initialize 1 unused element 0 to avoid errors
FoundIt = False
For i = 1 To Max
'Add a new item to the array

'Find a blank slot

For j = 1 To UBound(mArray, 1)
If mArray(j).InUse = False Then
'Found a blank slot - reuse it

FoundIt = True
Exit For
End If
Next j
'If slot not found, create new one.

If FoundIt = False Then
'Allocate a new array slot

j = UBound(mArray, 1) + 1
ReDim Preserve mArray(0 To j)
End If
'Add item to slot

mArray(j).InUse = True
mArray(j).Value = i
Next i
For j = 1 To MaxModify
For i = 1 To Max
'Manipulate item in the array

mArray(i).Value = i
Next i
Next j
For i = 1 To Max
'Remove item in the array

mArray(i).InUse = False
Next i
lblArray.Caption = Format((timeGetTime - StartTime) / 1000, "#.00") & " seconds."
End Sub

Private Sub cmdCollection_Click()
StartTime = timeGetTime
Set mCol = New Collection
'Add item to the collection

For i = 1 To Max
mCol.Add i
Next i
'Modify item in collection - can't modify, must remove and readd

For j = 1 To MaxModify
For i = 1 To Max
mCol.Remove i
mCol.Add i
Next i
Next j
'Remove item from collection

For i = 1 To Max
mCol.Remove 1
Next i
lblCollection.Caption = Format((timeGetTime - StartTime) / 1000, "#.00") & " seconds."
End Sub

Private Sub cmdDictionary_Click()
StartTime = timeGetTime
Set mDict = New Dictionary
'Add item to the dictionary

For i = 1 To Max
j = mDict.Count + 1
mDict.Add j, i
Next i
'Modify item in the dictionary 500 times

For j = 1 To MaxModify
For i = 1 To Max
mDict(i) = i
Next i
Next j
'Remove item from the dictionary

For i = 1 To Max
mDict.Remove i
Next i
lblDictionary.Caption = Format((timeGetTime - StartTime) / 1000, "#.00") & " seconds."
End Sub

Private Sub Form_Load()
Text1.Text = 500
Text2.Text = 500
End Sub

Private Sub Text1_Change()
Max = Val(Text1.Text)
End Sub

Private Sub Text2_Change()
MaxModify = Val(Text2.Text)
End Sub
This program tests array, collection, and dictionary speed.
It adds a user-specified number of items to the object being
tested (array, collection, or dictionary), modifies all the
items in the object maxModify times, then removes the object.
The total time it takes to perform all this, is timed, and
displayed on-screen. Note that for a low number of
modifications to the data, dictionaries appear best, but as
you access or modify the data more, arrays clearly win out,
even with the additional time up-front to find an empty
array slot.