Fastest way to filter a Listobject directly to an array

[dumitrudan608]

Hi,

I've been researching ways to speed up the process of restoring defaults for the inputs in a large budgeting file, and I was wondering if you guys can help me find a faster way that I did. I noticed that the slowest part is actually getting the defaults and this is where i wonder if you have an easier solution.

If you already know the fastest solution please let me know and ignore my explanation below, just get me out of my missery

I'm looking for 2 solutions: 1 - restore all defaults, 2 - restore individual inputs (possibly in batches). Explanation: same code if it's fast for restoring all defaults will be slow for restoring individual.

Just some quick details about the structure, defaults are kept in table/listobject:
*Note, this apples to solution "1 - restore all defaults". I will expand it to restore individual inputs by using input.formula2 instead of loading usedrange.formula2 in an array to search if there are any changes vs the default formula

List object columns (I will not list all the headers, as I can extrapolate, but only the main ones):

• [Name] - named ranges that identify each input (cell in Excel)
  - Exceptions, in some cases in sheet "Country Inputs", 1 named range can identify 106 cells, one for each available country. They can either have 1 formula to restore for the whole area ( in this case the default will be reprezented by 1 row in the listobject) or each cell can have individual values/formulas (in this case we will have 106 rows in the Defaults listobject with the same name, but different values in column [Country]
• [Worksheet] - I always filter by 1 worksheet, as i extrad sheet.usedRange.values to an array.
• [Section] - part of a sheet, i use it to restore multiple inputs in batches. 1 sheet can have 12-25 sections.
• [Country] -used for the exception mentioned at the [Name] column
• [Value/Formula] - formula to be restored. It's stored with a # in front of it, i remove the # when i restore it.

I compared 2 methods : Recordset.filter Vs loading the Listobject values in an array and looping through it, and to my surprise, the Array method was faster, and the recordset method was buggy as hell, so i used Array going forward. (note, this was before adding the more advanced filters, so only searching by [Sheet] and [Section], but it's slower once i added everithing.

Loading from defaults: Global Inputs [sheet], GA [section]
00.35 seconds - recordset
00.12 seconds - array

Loading from defaults: Global Inputs [sheet]
00.54 seconds - recordset
00.13 seconds - array

This is the code I used to get the filtered defaults :
Just a few notes,

• i used "filterName As Variant| so I have the option to either give it 1 Namer or feed it a dictionary of names to filter on so when i loop through the rows in the Defaults Listobject i can just check using filterName.exists(value)
• some names are stored as 'Country Inputs'!CI_Reg_CT_OtherNotifications_row, but Excel removes the first ' when I get the .value, so I need to search with or withouth it
• i do a sequencial search, so if i'm looking for a named range, i always search by sheet first and if sheet not found i just go to next row.

Function rd_GetDefaultDict(ByRef dUniqueNames As Scripting.Dictionary, ByRef dHeaders As Scripting.Dictionary, _
                                            Optional filterSheet As String, Optional filterSection As Variant, Optional filterName As Variant, _
                                            Optional isOnlyBlueGreenCells As Boolean = True, Optional isRestoreOnlyWp = False) As Scripting.Dictionary
                                           
    Dim dResult As New Scripting.Dictionary, dUnique As New Scripting.Dictionary
    Dim LO_default As ListObject
    Dim arrAll() As Variant
    Dim dHe As New Scripting.Dictionary
    Dim rowI As Long, colI As Long, lastRow As Long, lastCol As Long
   
    Set LO_default = LO_getDefaultsTable
    Set dHe = LO_GetHeadersDict(LO_default, False)
   
    arrAll = LO_default.DataBodyRange.value
   
    lastRow = UBound(arrAll, 1)
    lastCol = UBound(arrAll, 2)

    dResult.add dResult.Count + 1, dHe.Keys
   
    For rowI = 1 To lastRow
        'FILTER SHEET
        If filterSheet <> "" And UCase(arrAll(rowI, dHe("Worksheet"))) <> UCase(filterSheet) Then
            GoTo nextRowI
        End If
       
        'FILTER SECTION
         Select Case typeName(filterSection)
            Case "String"
                If filterSection <> "" And UCase(arrAll(rowI, dHe("Section"))) <> UCase(filterSection) Then
                    GoTo nextRowI
                End If
           
             Case "Dictionary"
                If filterSection.Count = 0 Then: GoTo nextRowI
                If Not filterSection.Exists(UCase(arrAll(rowI, dHe("Section")))) And Not filterSection.Exists("'" & UCase(arrAll(rowI, dHe("Section")))) Then
                    GoTo nextRowI
                End If
        End Select
               
        'FILTER INPUTS ONLY
        If isOnlyBlueGreenCells Then
            Select Case UCase(arrAll(rowI, dHe("Restore Color")))
                Case "BLUE", "GREEN":                    'CONTINUE
                Case Else: GoTo nextRowI
            End Select
        End If
       
        'FILTER RESTORE ONLY WP
        If isRestoreOnlyWp Then
            If arrAll(rowI, dHe("Restore with WP")) <> 1 Then
                GoTo nextRowI
            End If
        End If
       
        'FILTER NAME
        Select Case typeName(filterName)
            Case "String"
                If filterName <> "" And UCase(arrAll(rowI, dHe("Name"))) <> UCase(filterName) And "'" & UCase(arrAll(rowI, dHe("Name"))) <> UCase(filterName) Then
                    GoTo nextRowI
                End If
               
            Case "Dictionary"
                If filterName.Count = 0 Then: GoTo nextRowI
                If Not filterName.Exists(UCase(arrAll(rowI, dHe("Name")))) And Not filterName.Exists("'" & UCase(arrAll(rowI, dHe("Name")))) Then
                    GoTo nextRowI
                End If
        End Select
       
        'GET ALL CONTENT
        Dim arrTemp
        ReDim arrTemp(0 To dHe.Count - 1)
       
        For colI = 1 To lastCol
            arrTemp(colI - 1) = arrAll(rowI, colI)
        Next colI
                       
        dResult.add dResult.Count + 1, arrTemp
       
        'GET UNIQUE NAMES
        Dim sName
        sName = UCase(arrAll(rowI, dHe("Name")))
        If dUnique.Exists(sName) Then
            dUnique(sName) = dUnique(sName) + 1
        Else
            dUnique.add sName, 1
        End If
       
nextRowI:
    DoEvents
    Next rowI

    Set rd_GetDefaultDict = dResult
    Set dUniqueNames = dUnique
    Set dHeaders = LO_GetHeadersDict(LO_default, True)
End Function