IndexedArray Class: Uses a Dictionary Keys to Index a 2 Dimensional Array of Values

Question

This class encapsulates a 2D Array and a Scripting Dictionary. Values are add or returned from to the Array using a Key and a ColumnIndex, e.g. IndexedArray(Key, ColumnIndex) = Value . The Key is used to get the RowIndex of the Array. The Value is then added to the Array, e.g. Array(ColumnIndex, RowIndex).

Although, I am quite pleased with the performance, flexibility, and ease of use, I am open to any suggestions on how to improve its design.

IndexedArray:Class

Attribute VB_Description = "Uses a Scripting.Dictionary (m.Dictionary) to Index and Array of Values"
Option Explicit
Private Const DEFAULT_ROW_BUFFER As Long = 100
Attribute DEFAULT_ROW_BUFFER.VB_VarDescription = "The number of rows added to m.Values when resized"
Private Const DEFAULT_COLUMN_COUNT As Long = 10
Attribute DEFAULT_COLUMN_COUNT.VB_VarDescription = "The default number of Columns in m.Values"
Private Type Members
    ColumnCount As Long
    Dictionary As Object
    Initiated As Boolean
    Values As Variant                                 'Values(Columns, Rows)
End Type

Private m As Members
Attribute m.VB_VarDescription = "Encapsulates Class Member Fields For VBA Like m Reference (e.g. m.Value is simular to VBA m_Value)"

Private Sub Class_Initialize()
    Set m.Dictionary = CreateObject("Scripting.Dictionary")
    m.ColumnCount = DEFAULT_COLUMN_COUNT
    ReDim m.Values(1 To m.ColumnCount, 1 To DEFAULT_ROW_BUFFER)
End Sub

Public Property Get Value(ByVal Key As Variant, ByVal ColumnIndex As Long) As Variant
Attribute Value.VB_Description = "Gets or sets m.Values() element at Index returned by m.Dictionary(Key)"
Attribute Value.VB_UserMemId = 0
    If Not m.Dictionary.Exists(Key) Then Expand Key
    Value = m.Values(ColumnIndex, m.Dictionary(Key))
End Property

Public Property Let Value(ByVal Key As Variant, ByVal ColumnIndex As Long, ByVal vValue As Variant)
    If Not m.Dictionary.Exists(Key) Then Expand Key
    m.Values(ColumnIndex, m.Dictionary(Key)) = vValue
End Property

Public Function Exists(Key As Variant) As Boolean
Attribute Exists.VB_Description = "Tests if Key Exists in m.Dictionary"
    Exists = m.Dictionary.Exists(Key)
End Function

Private Sub Expand(ByVal Key As Variant)
Attribute Expand.VB_Description = "Adds new Key to m.Dictionary and Increase adds an additional number of rows to m.Values equal to DEFAULT_ROW_BUFFER."
    m.Dictionary.Add Key, m.Dictionary.Count + 1
    If m.Dictionary.Count > UBound(m.Values, 2) Then ReDim Preserve m.Values(1 To m.ColumnCount, 1 To UBound(m.Values, 2) + DEFAULT_ROW_BUFFER)
End Sub

Public Sub setColumnCount(ColumnCount As Long)
Attribute setColumnCount.VB_Description = "Changes the number of column in m.Values()"
    Dim Values As Variant
    Dim c As Long, r As Long
    If ColumnCount < 1 Then Err.Raise Number:=vbObjectError + 513, Description:="ColumnCount can not be less than 1"

    If m.ColumnCount <> ColumnCount Then
        ReDim Values(1 To ColumnCount, UBound(m.Values, 2))
        For r = 1 To UBound(m.Values)
            For c = 1 To IIf(m.ColumnCount < ColumnCount, m.ColumnCount, ColumnCount)
                Values(c, r) = m.Values(c, r)
            Next
        Next
        m.ColumnCount = ColumnCount
        m.Values = Values
    End If
End Sub

Public Sub EnsureCapacity(Capacity As Long)
    If UBound(m.Values, 2) < Capacity Then ReDim Preserve m.Values(1 To m.ColumnCount, 1 To Capacity)
End Sub

Public Function ToArray(Optional SearchString As String, Optional IncludeHeaderRows As Boolean) As Variant()
Attribute ToArray.VB_Description = "Return 2D Array of Values(Rows, Columns) either filtered or unfiltered.  Array filtering is delagated to ToFilteredArray"
    Dim Values As Variant
    Dim c As Long, r As Long

    If Len(SearchString) = 0 Then
        ReDim Values(1 To m.Dictionary.Count, 1 To m.ColumnCount)
        For r = 1 To m.Dictionary.Count
            For c = 1 To m.ColumnCount
                Values(r, c) = m.Values(c, r)
            Next
        Next
        ToArray = Values
    Else
        ToArray = ToFilteredArray(SearchString, IncludeHeaderRows)
    End If
End Function

Private Function ToFilteredArray(SearchString As String, IncludeHeaderRows As Boolean) As Variant()
Attribute ToFilteredArray.VB_Description = "Returns a 2D Array of filtered Values(Rows, Columns) to ToArray"
    Dim Key As Variant, header As Variant, Values As Variant
    Dim c As Long, r As Long, n As Long
    With CreateObject("System.Collections.ArrayList")
        If IncludeHeaderRows Then
            header = m.Dictionary.Keys()(0)
            .Add header
        End If
        For Each Key In m.Dictionary.Keys()
            If Key Like SearchString And Not .Contains(Key) Then .Add Key
        Next

        If .Count = 0 Then
            ReDim Values(1 To 1, 1 To 1)
            Values(1, 1) = vbNullString
        Else
            .Sort
            If Not IsEmpty(header) Then
                .Remove header
                .Insert 0, header
            End If

            ReDim Values(1 To .Count + 1, 1 To m.ColumnCount)
            For Each Key In .ToArray
                n = n + 1
                r = m.Dictionary(Key)
                For c = 1 To m.ColumnCount
                    Values(n, c) = m.Values(c, r)
                Next
            Next
        End If
    End With

    ToFilteredArray = Values
End Function

Test Routine

Note: constants prefixed with order belong to Public Enum OrderColumns. OrderColumns enumerates all the columns on the Worksheet("Orders").

Public Sub UpdateSummary(KeyColumn As Long, Optional SearchString As String, Optional IncludeHeaderRows As Boolean)
    Dim t As Long
    Application.ScreenUpdating = False
    Dim idxArray As New IndexedArray, Key As Variant, row As Range

    t = Timer
    With ThisWorkbook.Worksheets("Orders")
        Key = "Header Row"
        idxArray(Key, 1) = .Cells(KeyColumn).Value
        idxArray(Key, 2) = "Count"
        idxArray(Key, 3) = "Average"
        idxArray(Key, 4) = .Cells(orderSales).Value
        idxArray(Key, 5) = .Cells(orderQuantity).Value
        idxArray(Key, 6) = .Cells(orderDiscount).Value
        idxArray(Key, 7) = .Cells(orderProfit).Value

        For Each row In .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).EntireRow
            With row
                Key = .Cells(KeyColumn)
                idxArray(Key, 1) = .Cells(KeyColumn).Value
                idxArray(Key, 2) = idxArray(Key, 4) + 1
                idxArray(Key, 3) = "=AVERAGE(RC[-2]:RC[-1])"
                idxArray(Key, 4) = .Cells(orderSales).Value + idxArray(Key, 4)
                idxArray(Key, 5) = .Cells(orderQuantity).Value + idxArray(Key, 5)
                idxArray(Key, 6) = .Cells(orderDiscount).Value + idxArray(Key, 6)
                idxArray(Key, 7) = .Cells(orderProfit).Value + idxArray(Key, 7)
            End With
        Next
    End With
    Debug.Print Round(Timer - t, 2)
    CreateSummaryTable idxArray.ToArray(SearchString, IncludeHeaderRows)

    Application.ScreenUpdating = True
End Sub

Immediate Window Test

UpdateSummary orderCustomer_Name

UpdateSummary orderCustomer_Name, "*Alan*", False

UpdateSummary orderCustomer_Name, "*Alan*", True

UpdateSummary orderOrder_ID, "*CA-2014-##3###*", True

Download: IndexedArray.xlsm