AWE_SheetArray

Updated 1/14/2024

AWE_SheetArray is an Excel Class Module that can assist you in updating large spreadsheets quickly and easily, with just a few calls. With its ability to manipulate up to a million rows of data in seconds, AWE_SheetArray is an excellent tool to accelerate your Worksheet automation.

Behind the scenes, AWE_SheetArray converts sheet ranges to arrays, allowing for a fast search, update, and even writing back to the sheet. It also sorts multiple column keys that are searched using pattern syntax. If array data is updated, it can be written back to the sheet.

AWE_SheetArray can be used as a stand-alone class or as a complementary tool for the AWE_Sheet class.

Find and Update Data

FAST - Designed to store multiple column ranges (can be unioned together) for up to one million rows in arrays. This allows for quick retrieval and updating of data that can then be easily written back to the sheet.

Multi-Column Keys - Create multi-column keys that are sorted, making it easier to locate data in the array.

Performance - This method took 15 seconds to process 1 million rows:

Initialize - 0 seconds
CreatedKeys - 12 seconds
FindRows & FindCells - 0 seconds
WriteRows - 3 seconds

Conventional VBA Worksheet methods would have taken minutes.

Tips - Call "CreateKeys" and "WriteArray" functions at the beginning and end of your processing.

Public Sub FindAndUpdateData()
    Dim vRow As Variant, AWEArr As New AWE_SheetArray
    
    '--- Initialize the AWE_SheetArray ---
    With ActiveSheet
        AWEArr.Initialize 3, Union(.Range("$I$4", "$I$1000004"), _
            .Range("$B$4", "$B$1000004"), .Range("$J$4", "$J$1000004"))
    End With
        
    '--- Define keys that are used to find data in your array ---
    AWEArr.CreateKeys "Task ID", "Date"
    
    '--- Find Data, the below finds all TasksIDs="Task-101" in Feb 2021 ---
    For Each vRow In AWEArr.FindRows("Task-101", "2021/02/*")
        
        '--- Update data in the array ---
        AWEArr.FindCells(vRow, "Note") = "Found"
    
        '--- Retrieve data from the array ---
        Debug.Print AWEArr.FindCells(vRow, "Email Address") & ", " & AWEArr.FindCells(vRow, "Date")
    Next vRow
     
    '--- Write the updated array back to the sheet ---
    AWEArr.WriteArray
End Sub

Implementation

Copy AWE_SheetArray to a Class Module in your Workbook. See How to Create a Class Module for more information.

Function definitions, parameters and examples are included in the comments before each property or function.

Visual Basics Class IntelliSense will provide a code completion aid for the AWE_Sheet Class Module by listing its functions and parameters as you type your code.

'=====================================================================================================
' AWE_SheetArray: AWE_SheetArray is an Excel Class Module that can assist you in updating large
'    spreadsheets quickly and easily, within just a few calls. With its ability to manipulate up to
'    one million rows of data in seconds, AWE_SheetArray is an excellent tool for
'    automating your work.
'
'    This class module converts sheet ranges to arrays, allowing for a fast search, update, and
'    even writing back to the sheet. It also sorts multiple column keys that are searched using
'    pattern syntax. If array data is updated, it can be written back to the sheet.
'
'    AWE_SheetArray can be used as a stand-alone class or as a complementary tool to the
'    AWE_Sheet class.
'
' SITE:   www.AutomationWithExcel.com
' Author: Mike Libby
'=====================================================================================================

'=== PRIVATE VARIABLES ===============================================================================
'-----------------------------------  WORKSHEET VARIABLES
Private m_WS As Worksheet    ' Worksheet
Private m_ColRng As Range           ' Range Columns (can be unioned together)
Private m_HdrRowNb As Long          ' Header Row Number
Private m_MaxRow   As Long          ' Maximum number of rows
'-----------------------------------  KEY ARRAY VARIABLES
Private m_KeyRowValArr As Variant   ' Stores Key Row Values
Private m_KeyRowNbrArr As Variant   ' Stores the actual sheet Key Row Numbers
Private m_KeyColNamArr As Variant   ' Key Column Name Array
Private m_KeyColFmtArr As Variant   ' Key Column Format Array
'-----------------------------------  SHEET.RANGE.VALUE ARRAY VARIABLES
Private m_RngValArr As Variant      ' Range Value Array
Private m_RngHdrArr As Variant      ' Range Header Array
'-----------------------------------  TIMER VARIABLES
Private m_Time As Long              ' Records the elapsed time in seconds

'----------------------------------------------------------------------------------------------------
' ElapsedTime: Start and retrieve a timer for use in measuring performance speed.
' Example: AWESh.ElapedTime or Debug.Print AWESh.ElapsedTime
'----------------------------------------------------------------------------------------------------
Public Function ElapsedTime(Optional Tmr As Long = 0)
    If Tmr <> 0 Or m_Time = 0 Then m_Time = Timer
    ElapsedTime = Format((Timer - m_Time) / 86400, "hh:mm:ss")
End Function

'----------------------------------------------------------------------------------------------------
' Initialize: Store multi-column range headers and values in arrays for fast retrieval and
'             updating. Non-congruent ranges can be unioned together.
' Params:
'    - HdrRowNb As Long, The header's row number
'    - ColRng As Range, multi-column range that is to be stored in an array.
'    - MaxRows As Long - Specifies the maximum number of rows if the range is to be resized.
' Example: Store a range of 10 columns by 1,000 rows in an array and resize it to 1,000,000 rows.
'    Dim AWEArr As New AWE_SheetArray
'    AWEArr.Initialize 3, ActiveSheet.Range("$A$4", "$J$1004"), 1,000,000
'----------------------------------------------------------------------------------------------------
Public Function Initialize(HdrRowNb As Long, ColRng As Range, Optional MaxRows As Long = 0)
    Dim rCol As Range, aCol As Range, vCol As Variant, iCol As Long, iColCnt As Long
    Dim iRow As Long, rHdr As Range, iHdrNm As Long, sNbFmt As String
    Dim aKeyArr As Variant, HdrArr As Variant, vHdrNm As Variant
    
    Set m_WS = ColRng.Parent: Set m_ColRng = ColRng: m_HdrRowNb = HdrRowNb: m_MaxRow = MaxRows
    On Error Resume Next

    '=== Store Column Header and Values ===
    For Each rCol In m_ColRng.Columns: iColCnt = iColCnt + rCol.Areas.Count: Next rCol
    ReDim m_RngValArr(1 To iColCnt, 1 To 2)
    ReDim m_RngHdrArr(1 To iColCnt)
    iCol = 0
    For Each rCol In m_ColRng.Columns
        For Each aCol In rCol.Columns: iCol = iCol + 1
            Set rHdr = m_WS.Cells(m_HdrRowNb, aCol.Column)
            If MaxRows > 0 Then Set aCol = aCol.Resize(MaxRows)
            m_RngHdrArr(iCol) = rHdr.Value: m_RngValArr(iCol, 1) = rHdr.Column
            m_RngValArr(iCol, 2) = aCol.Value
        Next aCol
    Next rCol
End Function

'----------------------------------------------------------------------------------------------------
' CreateKeys - The function "CreateKeys" generates an array of row keys and their corresponding
'     numbers in a sorted order. To create each row key, the function concatenates the row
'     column values in the order they appear. The order of the columns also determines the
'     sort order of the array.
' Params:
'   - ParamArray KeyColNms() As Variant, The "KeyColNms" parameter defines the columns to concatenate
'        for row keys and array sort order. Note that these columns aren't required in the
'        "Initialize" function's "ColRng" parameter..
' Example:
'   - Create row keys for column names, "Task ID" and "Date".
'     Dim AWEArr As New AWE_SheetArray: AWEArr.Initialize 3, ActiveSheet.Range("$A$4", "$J$1000004")
'     AWEArr.CreateKeys "Task ID", "Date"
'----------------------------------------------------------------------------------------------------
Public Function CreateKeys(ParamArray KeyColNms() As Variant)
    Dim rCol As Range, vCol As Variant, iCol As Long, iRow As Long, iHdrNm As Long, sNbFmt As String
    Dim aKeyArr As Variant, HdrArr As Variant, vHdrNm As Variant
    On Error Resume Next
    
    If IsArray(m_KeyRowValArr) Then Erase m_KeyRowValArr
    If IsArray(m_KeyRowNbrArr) Then Erase m_KeyRowNbrArr
    If IsArray(m_KeyColNamArr) Then Erase m_KeyRowValArr
    If IsArray(m_KeyColFmtArr) Then Erase m_KeyRowValArr
    
    With m_WS
        '=== Create Lookup Key Arrays ===
        ReDim m_KeyColNamArr(1 To UBound(KeyColNms) + 1)
        ReDim m_KeyColFmtArr(1 To UBound(KeyColNms) + 1)
        ReDim aKeyArr(1 To m_ColRng.Rows.Count + 1, 1 To 2)
        
        HdrArr = .Range(.Cells(m_HdrRowNb, 1), .Cells(m_HdrRowNb, _
            .Cells(m_HdrRowNb, .Columns.Count).End(xlToLeft).Column))

        '--- Loop through each key column saving values to arrays  ---
        For Each vHdrNm In KeyColNms: iHdrNm = iHdrNm + 1
            '--- Get the sheet column number and range based the column location in the HdrArr ---
            iCol = -1: iCol = Application.WorksheetFunction.Match(vHdrNm, HdrArr, 0)
            '--- Display column not found error and end processing ---
            If iCol = -1 Then MsgBox m_WS.Name & "::AWE_LookupArray::Initialize Error." _
                & vbLf & vbLf & "Missing Column, """ & vHdrNm & ".""", vbCritical: End

            Set rCol = .Range(.Cells(m_ColRng.Row, iCol), _
                .Cells(m_ColRng.Row + m_ColRng.Rows.Count, iCol))
            
            '--- Capture column number formatting ---
            m_KeyColNamArr(iHdrNm) = rCol.EntireColumn.Cells(m_HdrRowNb).Value
            sNbFmt = rCol.NumberFormat
            If InStr(1, sNbFmt, "yy", vbTextCompare) Then sNbFmt = "yyyy/mm/dd"
            m_KeyColFmtArr(iHdrNm) = sNbFmt
            
            '--- Create\save the key ---
            vCol = rCol.Value
            For iRow = LBound(vCol) To UBound(vCol)
                If sNbFmt = "General" Then aKeyArr(iRow, 1) = aKeyArr(iRow, 1) & vCol(iRow, 1) & "|" _
                Else aKeyArr(iRow, 1) = aKeyArr(iRow, 1) & Format(vCol(iRow, 1), sNbFmt) & "|"
            Next iRow
        Next vHdrNm
        
        '--- Save each key's row number and then sort the entire array ---
        For iRow = LBound(aKeyArr) To UBound(aKeyArr): aKeyArr(iRow, 2) = iRow: Next iRow
        QSort2DArr aKeyArr, 1, LBound(aKeyArr), UBound(aKeyArr)
        
        '--- Save the key and row number to their respective arrays to speed match calls ---
        m_KeyRowValArr = Application.WorksheetFunction.Index(aKeyArr, 0, 1)
        m_KeyRowNbrArr = Application.WorksheetFunction.Index(aKeyArr, 0, 2)
    End With
End Function


'----------------------------------------------------------------------------------------------------
' FindRows: Retrieve the row numbers that match the specified column keys.
'
' Note: The function "FindRows" makes use of Column Keys which are created by concatenating them
'    together, storing them in an array and sorting them in the "CreateKeys" function. The "FindRows"
'    function uses "match" to find the first row and "like" to find subsequent rows.
'
'    It's crucial to consider the order of the keys used in the "CreateKeys" function as it
'    determines the sort order used when searching for subsequent rows. If an expected subsequent
'    row is not retrieved, it's likely because the columns specified in the "CreateKeys" function
'    are out of order.
'
'    Use match and like string patterns to find data:
'      - ?, Any single character
'      - *, Zero or more characters
'      - [charlist],  any single character in the charlist
'      - [!charlist], any single hcaracter not in charlist
'    For more information on string patterns, see Microsoft article...
'    https://learn.microsoft.com/en-us/dotnet/visual-basic/language-reference/operators/like-operator
'
' Params:   ParamArray Keys() as Variant - Keys concatenated together delimated by '|'. Can use
' Example: List all employees (in a 1,000,000 row sheet) that billed to "Task-101" in December, 2024.
'     Dim vRow As Variant, AWEArr As New AWE_SheetArray
'     AWEArr.Initialize 3, ActiveSheet.Range("$A$4", "$J$1000004")
'     AWEArr.CreateKeys "Task ID", "Date"
'     For Each vRow In AWEArr.FindRows("Task-101", "2021/12/*")
'        Debug.Print AWEArr.FindCells(vRow, "Employee Nbr") & ", " & vRow
'     Next vRow
'----------------------------------------------------------------------------------------------------
Public Function FindRows(ParamArray Keys() As Variant) As Collection
    Dim iRow As Long, iKey As Long, vKey As Variant, sNbFmt As String, sKeyVal As Variant
    Dim var As Variant, iCol As Long, collectn As New Collection:
    On Error Resume Next
    
    '--- Create the key ---
    For iKey = LBound(Keys) To UBound(Keys): vKey = Keys(iKey)
        sNbFmt = m_KeyColNamArr(iKey + 1)
        If sNbFmt = "" Then sKeyVal = sKeyVal & vKey & "|" Else sKeyVal = sKeyVal & Format(vKey, sNbFmt) & "|"
    Next iKey
    
    '--- Find the first occurance ---
    iRow = -1: iRow = Application.WorksheetFunction.Match(sKeyVal, m_KeyRowValArr, 0)
    
    '--- Update return value, collectn and FoundValues collections ---
    Do While iRow <> -1
        collectn.Add m_KeyRowNbrArr(iRow, 1) + (m_HdrRowNb)
        iRow = iRow + 1: If iRow > UBound(m_KeyRowNbrArr) Or Not (m_KeyRowValArr(iRow, 1) Like sKeyVal) Then Exit Do
    Loop
    Set FindRows = collectn
End Function

'----------------------------------------------------------------------------------------------------
' FindCells: The "FindCells" Get Property returns a value in the array based on row number and
'    column name or number.
' Params:
'    - RowNb as Variant - The Array Row that contains the data
'    - ColNmOrNb as Variant - The Column name or number that contains the data. Note, use column
'         number to improve speed on huge spreadsheets.
' Example: List all employees (in a 1,000,000 row sheet) that billed to "Task-101" in Dec, 2024.
'     Dim vRow As Variant, AWEArr As New AWE_SheetArray
'     AWEArr.Initialize 3, ActiveSheet.Range("$A$4", "$J$1000004")
'     AWEArr.CreateKeys "Task ID", "Date"
'     For Each vRow In AWEArr.FindRows("Task-101", "2021/12/*")
'        AWEArr.FindCells(vRow, "Note") = "Found"
'     Next vRow
'----------------------------------------------------------------------------------------------------
Public Property Get FindCells(RowNb As Variant, ColNmOrNb As Variant) As Variant
    Dim iCol As Long
    On Error Resume Next
    Select Case TypeName(ColNmOrNb)
        Case "Long", "Integer": iCol = CLng(ColNmOrNb)
        Case "String":
            '--- Find the column name's column number ---
            iCol = -1: iCol = Application.WorksheetFunction.Match(ColNmOrNb, m_RngHdrArr, 0)
            If iCol = -1 Then MsgBox m_WS.Name & "::AWE_LookupArray::FindCells Error." & vbLf & vbLf & _
                    "Missing Column, """ & ColNmOrNb & ".""", vbCritical: End
    End Select
    '--- Return the array column value ---
    FindCells = m_RngValArr(iCol, 2)(RowNb - m_HdrRowNb, 1)
End Property

'----------------------------------------------------------------------------------------------------
' FindCells: The "FindCells Let Property updates an array value based on row number and column name
'   or number.
' Params:
'    - RowNb as Variant - The Array Row that contains the data
'    - ColNmOrNb as Variant - The Column name or number that contains the data. Note, use column
'         number to improve speed on huge spreadsheets.
' Example: Update the note column to "Found" for employees that billed to "Task-101" in Dec, 2024.
'     Dim vRow As Variant, AWEArr As New AWE_SheetArray
'     AWEArr.Initialize 3, ActiveSheet.Range("$A$4", "$J$1000004")
'     AWEArr.CreateKeys "Task ID", "Date"
'     For Each vRow In AWEArr.FindRows("Task-101", "2021/12/*")
'        AWEArr.FindCells(vRow, "Note") = "Found"
'     Next vRow
'     AWEArr.WriteArray
'----------------------------------------------------------------------------------------------------
Public Property Let FindCells(RowNb As Variant, ColNmOrNb As Variant, Value As Variant)
    Dim iCol As Long
    On Error Resume Next
    Select Case TypeName(ColNmOrNb)
        Case "Long", "Integer": iCol = CLng(ColNmOrNb)
        Case "String":
            '--- Find the column name's column number ---
            iCol = -1: iCol = Application.WorksheetFunction.Match(ColNmOrNb, m_RngHdrArr, 0)
            If iCol = -1 Then MsgBox m_WS.Name & "::AWE_LookupArray::FindCells Error." & vbLf & vbLf & _
                    "Missing Column, """ & ColNmOrNb & ".""", vbCritical: End
    End Select
    '--- Set the array value ---
    m_RngValArr(iCol, 2)(RowNb - m_HdrRowNb, 1) = Value
End Property

'----------------------------------------------------------------------------------------------------
' WriteArray: The function "WriteArray" writes all the values stored in the array back to the range
'    that was defined in the "Initialize" function.
' Example: Update the note column to "Found" for employees that billed to "Task-101" in Dec, 2024.
'     Dim vRow As Variant, AWEArr As New AWE_SheetArray
'     AWEArr.Initialize 3, ActiveSheet.Range("$A$4", "$J$1000004")
'     AWEArr.CreateKeys "Task ID", "Date"
'     For Each vRow In AWEArr.FindRows("Task-101", "2021/12/*")
'        AWEArr.FindCells(vRow, "Note") = "Found"
'     Next vRow
'     AWEArr.WriteArray
'----------------------------------------------------------------------------------------------------
Public Function WriteArray()
    Dim aCol As Range, rCol As Range, iCol As Long
    '--- Write each column back to the sheet ---
    For Each rCol In m_ColRng.Columns
        For Each aCol In rCol.Columns: iCol = iCol + 1
            rCol.Value = m_RngValArr(iCol, 2)
        Next aCol
    Next rCol
End Function

'==== Private Functions ==============================================================================
Private Function QSort2DArr(arr As Variant, SortCol As Long, First As Long, Last As Long)
  Dim vMidVal As Variant, vTemp As Variant, lTempLow As Long, lTempHi As Long, i2D As Long
  lTempLow = First: lTempHi = Last
  '--- Find midpoint, divide and conquer ---
  vMidVal = arr((First + Last) \ 2, SortCol)
  Do While lTempLow <= lTempHi
    '--- Find low occurance ---
    Do While arr(lTempLow, SortCol) < vMidVal And lTempLow < Last: lTempLow = lTempLow + 1: Loop
    '--- Find high occurance ---
    Do While vMidVal < arr(lTempHi, SortCol) And lTempHi > First: lTempHi = lTempHi - 1: Loop
    
    If lTempLow <= lTempHi Then
        '--- Swap 2D array elements ---
        For i2D = LBound(arr, 2) To UBound(arr, 2)
            vTemp = arr(lTempLow, i2D)
            arr(lTempLow, i2D) = arr(lTempHi, i2D)
            arr(lTempHi, i2D) = vTemp
        Next i2D
        lTempLow = lTempLow + 1: lTempHi = lTempHi - 1
    End If
  Loop
  '--- Recursive ---
  If First < lTempHi Then QSort2DArr arr, SortCol, First, lTempHi
  If lTempLow < Last Then QSort2DArr arr, SortCol, lTempLow, Last
End Function