Arrays, collections and dictionaries

Use static and dynamic arrays well, ReDim Preserve without quadratic costs, and reach for Scripting.Dictionary for lookups.

Arrays and ReDim

Option Explicit

Sub StaticArrays()
    ' explicit bounds: 0 to 4 unless Option Base 1 says otherwise
    Dim fixed(4) As Long
    fixed(0) = 1

    ' set both bounds explicitly and avoid the Option Base question entirely
    Dim zero(0 To 4) As Long
    Dim one(1 To 5) As Long

    ' a 2D array from a worksheet block: always 1-based
    Dim block As Variant
    block = Sheet1.Range("A1:C10").Value2
    Debug.Print LBound(block, 1), UBound(block, 1)   ' 1 and 10
    Debug.Print LBound(block, 2), UBound(block, 2)   ' 1 and 3
End Sub

Sub DynamicArrays()
    Dim items() As String
    Dim n As Long

    ReDim items(0 To 9)                 ' size it once when you know the count
    items(0) = "ada"

    ' ReDim Preserve can only change the LAST dimension, and copies everything
    n = 10
    ReDim Preserve items(0 To n)

    ' when the size is unknown, collect into a collection or a dictionary
    ' and convert at the end, rather than growing an array per item
    Dim tmp As Collection
    Set tmp = New Collection
    Dim i As Long
    For i = 1 To 100
        tmp.Add "row" & i
    Next i

    ReDim items(0 To tmp.Count - 1)
    For i = 1 To tmp.Count
        items(i - 1) = tmp(i)
    Next i

    Debug.Print LBound(items), UBound(items), items(99)
End Sub

Sub TwoDimensional()
    Dim grid(1 To 3, 1 To 2) As Long
    Dim r As Long, c As Long
    For r = 1 To 3
        For c = 1 To 2
            grid(r, c) = r * 10 + c
        Next c
    Next r
    ' a 2D array cannot be ReDim Preserved in its first dimension
End Sub

• ReDim Preserve copies the entire array on every call, so growing one element at a time is quadratic. Size it once, or collect into a Collection and convert at the end.
• ReDim Preserve can only resize the last dimension. A 2D array cannot be widened in its first dimension.
• A block read from a worksheet is always 1-based in both dimensions, whatever the sheet's displayed row numbers are.
• An array cannot be assigned with Let to another array. arr2 = arr1 on a fixed array copies the contents; on a dynamic array it also works but only when the destination is a Variant. Assigning to a typed array of the wrong size is a run-time error.

Collection and Scripting.Dictionary

Sub Dictionaries()
    ' late binding: no reference needed in Tools, References
    Dim d As Object
    Set d = CreateObject("Scripting.Dictionary")

    ' early binding is faster and gives IntelliSense; add the reference
    ' Microsoft Scripting Runtime, then:
    ' Dim d As New Scripting.Dictionary

    d.CompareMode = 1                     ' 1 = TextCompare, case-insensitive
    d.Add "ada", 36
    d("grace") = 45                       ' the Item property adds or overwrites
    d("ada") = 37

    If d.Exists("ada") Then Debug.Print d("ada")
    Debug.Print d.Count
    Debug.Print Join(d.Keys, ", ")
    Debug.Print Join(d.Items, ", ")

    ' iterating: the For Each order is insertion order, not sorted
    Dim k As Variant
    For Each k In d.Keys
        Debug.Print k, d(k)
    Next k

    ' removing a key while iterating requires a snapshot of the keys
    Dim keys As Variant
    keys = d.Keys
    Dim i As Long
    For i = LBound(keys) To UBound(keys)
        If d(keys(i)) < 40 Then d.Remove keys(i)
    Next i

    ' a Collection is simpler: ordered, with an optional key, but no Exists
    Dim c As Collection
    Set c = New Collection
    c.Add "first", "one"                  ' item, then key
    c.Add "second", "two"
    On Error Resume Next
    Debug.Print c("one")
    On Error GoTo 0
End Sub

Scripting.Dictionary is a Windows COM component. It is present on every Windows desktop that has Office, but not on macOS Office and not in some locked-down environments. Wrap it in a small factory function so you have one place to change if it is unavailable.

The patterns that pay off

' Sum by key: the classic dictionary aggregation
Function TotalsByCustomer(ws As Worksheet) As Object
    Dim lastRow As Long
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row

    Dim data As Variant
    data = ws.Range("A2:C" & lastRow).Value2      ' one read for the whole block

    Dim out As Object
    Set out = CreateObject("Scripting.Dictionary")

    Dim i As Long, key As String
    For i = 1 To UBound(data, 1)
        key = CStr(data(i, 1))
        If Len(key) > 0 Then
            If out.Exists(key) Then
                out(key) = out(key) + CDbl(data(i, 3))
            Else
                out.Add key, CDbl(data(i, 3))
            End If
        End If
    Next i

    Set TotalsByCustomer = out
End Function

Sub ShowTotals()
    Dim d As Object
    Set d = TotalsByCustomer(Sheet1)
    Dim k As Variant
    For Each k In d.Keys
        Debug.Print k, Format$(d(k), "#,##0.00")
    Next k
End Sub

' An array inside a dictionary replaces a nested loop with a single lookup.
' A set is just a dictionary whose values are ignored.
Function UniqueValues(ws As Worksheet) As String()
    Dim d As Object
    Set d = CreateObject("Scripting.Dictionary")
    d.CompareMode = 1

    Dim c As Range
    For Each c In ws.Range("A2:A" & ws.Cells(ws.Rows.Count, "A").End(xlUp).Row)
        If Len(CStr(c.Value)) > 0 Then d(CStr(c.Value)) = True
    Next c

    Dim out() As String
    If d.Count = 0 Then
        UniqueValues = Array()
        Exit Function
    End If
    ReDim out(0 To d.Count - 1)
    Dim i As Long
    For i = 0 To d.Count - 1
        out(i) = d.Keys()(i)
    Next i
    UniqueValues = out
End Function

FAQ

Related

Macros, worksheets and ranges Speed: ScreenUpdating, calculation and array transfers

Last refreshed 2026-09-18.