4
\$\begingroup\$

[edit] I realised why everyone does this with loops; my plan was to use .SpecialCells(xlCellTypeVisible).EntireRow.Address to return the row(s) of the results of the results of the filter, but that returns a string. Strings have a limit of 256 characters, so with even moderately fragmented data some will be truncated. However, I think this approach is still more efficient than grabbing the table contents row-by-row.

I recently needed to make an array from a filtered sheet. Because the filtered results will be in multiple areas, the code I found online all referred back to the sheet in loops. I believe I have come up with a much more efficient approach, which grabs all the table in one go, then grabs the information relating to the rows that are visible. It does not have to go row-by-row to grab the data, nor does it have to redim the array after its initial size is set.

Some operations could be combined (sacrificing readability for efficiency) but otherwise I think this is a faster and neater way than any I've yet seen.

I am particularly interested in any efficiency improvements, and any vulnerabilities which could/should be dealt with. Thanks in advance!

Function ArrayFromFilter(Table As Range) As Variant

    Dim FullData() As Variant, Trimdata() As Variant, FilterZones() As String, Filters() As String, FilterRows() As Long
    Dim numZones As Long, curZone As Long, curRow As Long, curCol As Long, FirstRow As Long
    Dim numItems As Long, i As Long, j As Long
    Dim Output As String

    FirstRow = Table.Rows(1).Row - 1 'this an offset used later
    
    'grab the entire unfiltered table - faster to process it in VBA than to cycle through on the sheet
    FullData() = Table
    
    'grab the result row numbers by area
    numZones = Table.SpecialCells(xlCellTypeVisible).Areas.Count
    ReDim Filters(1 To numZones)
    For curZone = 1 To numZones
        Filters(curZone) = Table.SpecialCells(xlCellTypeVisible).Areas(curZone).EntireRow.Address
    Next
    
    ReDim FilterZones(1 To numZones, 1 To 2)
    ReDim FilterRows(1 To numZones, 1 To 2)
    
    'split the zones into start and end rows
    For i = LBound(Filters()) To UBound(Filters())
        'first split each zone into its first and last rows
        FilterZones(i, 1) = Left(Filters(i), InStr(Filters(i), ":") - 1)
        FilterZones(i, 2) = Right(Filters(i), InStr(Filters(i), ":") + 1)
        'now take just the row from each cell and convert to a number, then remove the offset of the start of the data
        FilterRows(i, 1) = (CDbl(Split(FilterZones(i, 1), "$")(1)) - FirstRow)
        FilterRows(i, 2) = (CDbl(Split(FilterZones(i, 2), "$")(1)) - FirstRow)
        'ta-da we have an array with the first and last row of each zone inside the overall filtered data - now work out how many items there are
        numItems = numItems + (FilterRows(i, 2) - FilterRows(i, 1)) + 1
    Next
    
    'go through the table, moving only the useful bits to the trimmed data
    ReDim Trimdata(1 To numItems, 1 To UBound(FullData, 2))

    curRow = 1
    For i = 1 To numZones
        For j = FilterRows(i, 1) To FilterRows(i, 2)
            For curCol = 1 To UBound(FullData, 2)
                Trimdata(curRow, curCol) = FullData(j, curCol)
            Next
            curRow = curRow + 1
        Next
    Next

'uncomment this block for testing to show that the data has been grabbed
'    For i = 1 To UBound(Trimdata(), 1)
'        For j = 1 To UBound(Trimdata(), 2)
'            If j = 1 Then
'                Output = Trimdata(i, j)
'            Else
'                Output = Output & ", " & Trimdata(i, j)
'            End If
'        Next
'        Debug.Print Output
'    Next
    
    ArrayFromFilter = Trimdata

End Function
\$\endgroup\$

4 Answers 4

4
\$\begingroup\$

Use of error handlers with SpecialCells: Using SpecialCells in VBA can potentially throw errors, particularly Error 1004 when no cells of the specified type are found. It's good practice to have error handling in place for these instances. An example implementation might look like this:

On Error Resume Next Set rngSpecial = Table.SpecialCells(xlCellTypeVisible) If Err.Number <> 0 Then Err.Clear ' Handle error or exit function End If On Error GoTo 0

Storing the result of SpecialCells in a variable: The SpecialCells method is called multiple times in this code. This method can be resource intensive, particularly with larger ranges. Storing the result in a variable and then using that variable would improve efficiency. Example:

Dim rngSpecial As Range Set rngSpecial = Table.SpecialCells(xlCellTypeVisible) Now, you can use rngSpecial instead of calling Table.SpecialCells(xlCellTypeVisible) each time.

Misleading variable name - Trimdata: The variable name Trimdata can be misleading because in programming contexts, "trim" is often used to refer to removing white spaces from the start and/or end of strings. Here, a more accurate name might be FilteredData or VisibleData to better reflect that this array contains only the visible (i.e., unfiltered) data from the range.

Simpler calculation of row numbers: The calculation for the number of rows in a range can be simplified by dividing the total count of cells in the range by the count of columns. This can be done as follows:

numRows = Table.Count / Table.Columns.Count

Remember that this will give you the total number of rows, including those hidden by filters. If you only want the number of visible rows, you would need to perform this operation on the range returned by SpecialCells(xlCellTypeVisible).

' This function accepts a range in Excel (the "Table") as input and returns a filtered array that excludes any hidden or non-visible cells in the range.
Function ArrayFromFilteredRange(Table As Range) As Variant
    ' Declare a Range object to hold the target cells
    Dim Target As Range
    ' In case of any error in the following operations, program execution will resume at the next statement
    On Error Resume Next
    ' Assign to "Target" only the visible cells from "Table"
    Set Target = Table.SpecialCells(xlCellTypeVisible)
    ' Resets the error handling to its default behavior
    On Error GoTo 0
    ' If no visible cells were found, return an empty array and exit the function
    If Target Is Nothing Then
        ArrayFromFilteredRange = Array()
        Debug.Print "ArrayFromFilteredRange:", "Target Is Nothing"
        Exit Function
    End If

    ' Declare a variable to hold the number of columns in the target range
    Dim columnCount As Long
    columnCount = Target.Columns.Count

    ' Declare a variable to hold the number of rows in the target range
    Dim rowCount As Long
    rowCount = Target.Count / columnCount
 
    ' Declare an array to hold the data from the target range
    Dim Result As Variant
    ' Set the dimensions of the Result array to match the size of the target range
    ReDim Result(1 To rowCount, 1 To columnCount)

    ' Declare variables to assist in navigating the target range and populating the Result array
    Dim Area As Range
    Dim AreaData As Variant
    Dim c As Long, r As Long, row As Long

    ' Loop through each area of the target range
    For Each Area In Target.Areas
        ' Loop through each row in the current area
        For row = 1 To Area.Rows.Count
            ' Increment the row count for the Result array
            r = r + 1
            ' Extract the values from the current area
            AreaData = Area.Value
            ' Loop through each column in the current area
            For c = 1 To columnCount
                ' Assign the current cell's value to the corresponding element in the Result array
                Result(r, c) = AreaData(row, c)
            Next
        Next
    Next

    ' Return the Result array
    ArrayFromFilteredRange = Result
End Function

Addendum

I overlooked the whole point of the OP's code. He postulates that it is more efficient to load all the data into a variable and loop over it. As opposed to iterating over each areas values.

' This function calculates the relative row index of an area within a given target range.
' It takes the target range and area index as inputs and returns the relative row index.
Function GetAreaRelativeRowIndex(Target As Range, AreaIndex As Long) As Long

    ' Get the row number of the first cell in the given area within the target range
    ' Subtract the row number of the first cell in the target range to calculate the relative row index
    ' Adding 1 at the end accounts for the 1-based index system in VBA
    GetAreaRelativeRowIndex = Target.Areas(AreaIndex).Row - Target.Row + 1

End Function
' This function accepts a range in Excel (the "Table") as input and returns a filtered array
' that excludes any hidden or non-visible cells in the range.
Function FilteredRangeData(Table As Range) As Variant

    ' Declare a Range object to hold the target cells
    Dim Target As Range
    
    ' On Error Resume Next allows the program to continue with the next line of code 
    ' even if there is an error
    On Error Resume Next
    
    ' Assign to "Target" only the visible cells from "Table"
    ' .SpecialCells(xlCellTypeVisible) allows to target only cells that are visible
    Set Target = Table.SpecialCells(xlCellTypeVisible)
    
    ' Resets the error handling to its default behavior
    On Error GoTo 0

    ' If no visible cells were found or if Table is a single cell, 
    ' return an empty array and exit the function
    If Target Is Nothing Or Table.Count = 1 Then
        Dim EmtpyResult(1 To 1, 1 To 1) ' Define a 1x1 array
        FilteredRangeData = EmtpyResult ' Set function result as the empty array
        Debug.Print "FilteredRangeData:", "Target Is Nothing" ' Output message for debugging
        Exit Function ' Exit the function
    End If

    ' Declare a variable to hold the number of columns in the target range
    Dim columnCount As Long
    columnCount = Target.Columns.Count

    ' Declare a variable to hold the number of rows in the target range
    ' This is calculated by dividing the total count of cells in the target by the column count
    Dim rowCount As Long
    rowCount = Target.Count / columnCount
 
    ' Declare an array to hold the data from the target range
    Dim Result As Variant
    ' Set the dimensions of the Result array to match the size of the target range
    ReDim Result(1 To rowCount, 1 To columnCount)
    
    ' Declare a variable to store all values in the table
    Dim AllValues As Variant
    AllValues = Table.Value
    
    Dim AreaIndex As Long
    Dim AreaRowCount As Long
    Dim AreaRelativeRowIndex As Long
    Dim Count As Long
    Dim r As Long
    Dim c As Long
    
    ' Loop through all the areas in the target range
    For AreaIndex = 1 To Target.Areas.Count
        ' Get the relative row index of the current area in the target range
        AreaRelativeRowIndex = GetAreaRelativeRowIndex(Target, AreaIndex)
        ' Get the number of rows in the current area
        AreaRowCount = Target.Areas(AreaIndex).Rows.Count
        ' Loop through all the rows in the current area
        For r = AreaRelativeRowIndex To AreaRelativeRowIndex + AreaRowCount - 1
            ' Increment the count
            Count = Count + 1
            ' Loop through all the columns
            For c = 1 To columnCount
                ' Assign the cell value in AllValues to the corresponding cell in Result
                Result(Count, c) = AllValues(r, c)
            Next c
        Next r
    Next AreaIndex
    
    ' Return the Result array
    FilteredRangeData = Result
End Function
\$\endgroup\$
5
  • \$\begingroup\$ Thank you - I had spotted the specialcells error issue but not the rest; I will work through. I'm inclined to continue the approach of reading the entire table, then using the specialcells data to filter it in memory, as I think that will run faster. I also gather that dimming every variable at the top of the code isn't good practice so will fix that. \$\endgroup\$
    – Andi Allan
    Commented Jun 5, 2023 at 8:04
  • \$\begingroup\$ I think your approach to determining the rows in each area is probably a lot smarter than mine - I appear to have been stuck with my idea of parsing the string returned by .address. On reflection my approach is "clever" but might not be efficient. \$\endgroup\$
    – Andi Allan
    Commented Jun 6, 2023 at 7:27
  • \$\begingroup\$ @AndiAllan you premise was very clever. I've seen a lot of the address parsing over the years. \$\endgroup\$
    – TinMan
    Commented Jun 6, 2023 at 12:31
  • \$\begingroup\$ I did find an issue in your new code - with relatively unfragmented data, it's very slow. Moving the Areadata = Area.value line above the "for row = 1 to area.rows.count" line makes it much faster. I think at present yours is grabbing the entire area for every row it cycles through. With that change your code is very fast for chunky or fragmented tables - really nice. \$\endgroup\$
    – Andi Allan
    Commented Jun 6, 2023 at 12:33
  • \$\begingroup\$ @AndiAllan you are right. What was I thinking. Thanks. \$\endgroup\$
    – TinMan
    Commented Jun 6, 2023 at 13:48
4
\$\begingroup\$

Based on the comments from @Tinman I have updated and substantially changed my code. I've stuck with my initial idea of storing the entire data set, then storing the row numbers for the visible (ie filtered) data, and processing in memory, because I thought it ought to be quicker with less fragmented data.

Specific changes:

  • Moved all variable dim statements to just before the variable is first used
  • Added error trapping to the specialcells bit in case there are no visible cells
  • Stored the specialcells range to a variable
  • Renamed the filtered data array to something less misleading
  • Used the suggested table.count / table.columns.count approach to calculate the number of items
  • Fixed an error in the original Filterzones() code that used a Right where it should have used a Mid - the original worked by accident when a zone started and ended with row numbers with the same number of digits

My initial tests with a 5000 line range suggest that my expectation is true; once the data is heavily fragmented my code does take slightly longer, but if the data is in larger contiguous chunks it's significantly quicker. I suppose this makes it an alternative rather than a more efficient approach.

I am most grateful for the feedback - I have now voted for Tinman's answer.

Function ArrayFromFilter(Table As Range) As Variant

    Dim RowOffset As Long
    RowOffset = Table.Rows(1).row - 1 'this an offset used later
    
    'grab the entire unfiltered table - potentially faster to process it in VBA than to cycle through on the sheet
    Dim FullData() As Variant
    FullData() = Table
    
    'grab the filtered rows address(s)
    Dim Specials As Range
    On Error Resume Next
    Set Specials = Table.SpecialCells(xlCellTypeVisible)
    On Error GoTo 0
    If Specials Is Nothing Then
        ArrayFromFilter = Table
        GoTo MakeOutput
    End If
    
    'grab the result row numbers by area
    Dim numZones As Long
    numZones = Specials.Areas.Count
    
    'now work out how many items there are
    Dim numItems As Long
    numItems = Specials.Count / Specials.Columns.Count
    
    Dim Filters() As String
    ReDim Filters(1 To numZones)
    
    Dim curZone As Long
    For curZone = 1 To numZones
        Filters(curZone) = Specials.Areas(curZone).EntireRow.Address
    Next
    
    Dim FilterZones() As String
    ReDim FilterZones(1 To numZones, 1 To 2)
    ReDim FilterRows(1 To numZones, 1 To 2)
    
    'split the zones into start and end rows
    Dim i As Long
    For i = LBound(Filters()) To UBound(Filters())
        'first split each zone into its first and last rows
        FilterZones(i, 1) = Left(Filters(i), InStr(Filters(i), ":") - 1)
        FilterZones(i, 2) = Mid(Filters(i), InStr(Filters(i), ":") + 1)
        'now take just the row from each cell and convert to a number, then remove the offset of the start of the data
        FilterRows(i, 1) = (CDbl(Split(FilterZones(i, 1), "$")(1)) - RowOffset)
        FilterRows(i, 2) = (CDbl(Split(FilterZones(i, 2), "$")(1)) - RowOffset)
        'ta-da we have an array with the first and last row of each zone inside the overall filtered data
    Next
    
    'go through the table, moving only the useful bits to the trimmed data
    Dim FilteredData() As Variant
    ReDim FilteredData(1 To numItems, 1 To UBound(FullData, 2))

    Dim curRow As Long, j As Long, curCol As Long
    curRow = 1
    For i = 1 To numZones
        For j = FilterRows(i, 1) To FilterRows(i, 2)
            For curCol = 1 To UBound(FullData, 2)
                FilteredData(curRow, curCol) = FullData(j, curCol)
            Next
            curRow = curRow + 1
        Next
    Next
    
    ArrayFromFilter = FilteredData
    
MakeOutput:

'uncomment this block for testing to show that the data has been grabbed
'    Dim Output As String
'    For i = 1 To UBound(FilteredData(), 1)
'        For j = 1 To UBound(FilteredData(), 2)
'            If j = 1 Then
'                Output = FilteredData(i, j)
'            Else
'                Output = Output & ", " & FilteredData(i, j)
'            End If
'        Next
'        Debug.Print Output
'    Next

End Function
\$\endgroup\$
2
2
\$\begingroup\$

The code in the Addendum from Tinman isn't functional.

I would use the Addendum code, but instead of referencing the RelativeRowIndex, go by the Target.Areas(AreaIndex).Row.

If your target range first row is not row 1, then you need to subtract the number of rows ahead of your data.

With the code faster in large chunks, if sort order doesn't matter, sort the data then filter so that your data is least fragmented as possible. If sort order is important, add a helper column for the original sort and revert to original sort and delete helper column when done.

\$\endgroup\$
1
  • \$\begingroup\$ I'm considering another approach now (but gad other things to work on first); adding a hidden helper column with a SUBTOTAL based formula to indicate if the line is visible. Then you can grab the entire table, and copy only the visible lines into a new array based on that helper column. That should be very fast. \$\endgroup\$
    – Andi Allan
    Commented May 27 at 7:30
1
\$\begingroup\$

Inspired by M4dsc1's use of the phrase "helper column", I've come up with another approach - on the assumption that you can indeed add a helper column.

The helper column (assuming we're on line 47, and columns F to H always have something in them - at least a zero) contains a function along the lines of

=MIN(1,SUBTOTAL(3,F47:H47))

So that's a 1 if the row is visible, and 0 if it isn't. You then pass the full range, plus the position of the helper column within that range, to this function:

Function NewArrayFromFilter(Table As Range, HelperCol As Long) As Variant

    'this is a new way of grabbing the data that uses a helper column to determine which lines are visible, instead of looping through the sub ranges and parsing the addresses
    'this should be a lot quicker, particularly on fragmented data, as it only has one call to the sheet

    Dim RowOffset As Long
    RowOffset = Table.Rows(1).Row - 1 'this an offset used later

    'grab the entire unfiltered table - faster to process it in VBA than to cycle through on the sheet
    Dim FullData() As Variant
    FullData() = Table

    'work out how many lines are visible in total
    Dim i As Long, LineCount As Long
    LineCount = 0
    For i = LBound(FullData, 1) To UBound(FullData, 1)
        LineCount = LineCount + FullData(i, HelperCol)
    Next

    'size a new array to hold the stuff we need
    Dim FilteredData() As Variant
    ReDim FilteredData(1 To LineCount, 1 To UBound(FullData, 2))

    'loop through the fulldata array copying visible lines to the new array
    Dim CurCol As Long, WriteRow As Long, j As Long
    WriteRow = LBound(FilteredData, 1)
    For i = LBound(FullData, 1) To LineCount
        If FullData(i, HelperCol) = 1 Then
            For j = LBound(FullData, 2) To UBound(FullData, 2)
                  FilteredData(WriteRow, j) = FullData(i, j)
            Next
        WriteRow = WriteRow + 1
        End If
    Next

    NewArrayFromFilter = FilteredData

End Function

My initial tests suggest this is very fast indeed - noticeably faster than my previous approach, and works just as well on heavily fragmented data as on big contiguous blocks (there shouldn't be any speed difference as far as I can work out). You do end up with an array that includes the helper column.

Comments welcome as always.

\$\endgroup\$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.