Premise
I have written a function in VBA, called FILTER_RANGE()
, which accepts a Range
object and a filtration parameter. Unlike the existing FILTER()
function, this FILTER_RANGE()
will return a Range
object: the subset of the original Range
that was preserved by the filter.
"Filtering a Range"
To clarify what I mean by "filter a range and return a range", consider the following illustrations.
Rectangular Ranges
Here is a range named Rectangular
(in red), which is a simple rectangle:
I can filter Rectangular
by row...
' ...using a literal array...
= FILTER_RANGE(Rectangular, {FALSE; FALSE; FALSE; FALSE; TRUE; TRUE; TRUE; TRUE; TRUE; TRUE})
' ...a logical array...
= FILTER_RANGE(Rectangular, F4:F13 >= 5)
' ...or a range containing Boolean values.
= FILTER_RANGE(Rectangular, G4:G13)
...and return the filtered Range
object itself...
...rather than an array of its (blank) values as returned by FILTER()
.
My code also supports filtering by column:
In the future, I hope to filter simultaneously by both row and column:
Irregular Ranges
My function can also do the same for irregular ranges, like Irregular
(in blue):
Here are illustrated filtration by row...
...filtration by column...
...and simultaneous filtration by both row and column (not implemented yet):
Features
Analogously to FILTER()
, I have designed FILTER_RANGE()
to be of the form
FILTER_RANGE(range, include, [by_column], [if_empty])
where we have
range
: an arbitraryRange
object to be filtered. May be a standard range likeB4:D14
, or a named range likeIrregular
.include
: a set of logical filtration criteria, corresponding in size torange
. May be aBoolean
array, as withF4:F13 >= 5
; or aRange
containingBoolean
values, as withG4:G14
. Alternatively aBoolean
scalar:TRUE
to include everything;FALSE
to exclude everything.by_column
: Optional. ABoolean
scalar:TRUE
to filter by column, andFALSE
to filter by row. Defaults toFALSE
for rowwise filtration.if_empty
: Optional. ARange
object, which should be returned, rather than throwing an error, when the filter returns nothing (not implemented yet).
For additional context, when I add simultaneous filtration, the following form might apply instead:
FILTER_RANGE(range, include_rows, [include_columns], [if_empty])
range
include_rows
: an independent set of logical filtration criteria for the rows inrange
.include_columns
: Optional. An independent set of logical filtration criteria for the columns inrange
. Defaults toTRUE
to include all columns.if_empty
Working Solution
My current working solution
FILTER_RANGE(range, include, [by_column])
achieves most Features described in the first form above, for "rectangular" and "irregular" ranges alike. The only missing features are:
- the optional
[if_empty]
parameter, which is not yet implemented; and - simultaneous filtration, which would have the differing form of
FILTER_RANGE(range, include_rows, [include_columns], [if_empty])
.
Suggestions
In my Code shown below, I suspect there are a few opportunities for improvement:
- The
FILTER_RANGE_BY_ROW()
function usesCOUNT_ALL_ROWS()
to validate the dimensions, before callingGET_ALL_ROWS()
later on. However,COUNT_ALL_ROWS()
itself usesGET_ALL_ROWS()
, so this code is redundant. Likewise forFILTER_RANGE_BY_COLUMN()
withCOUNT_ALL_COLUMNS()
andGET_ALL_COLUMNS()
. - The algorithms are currently iterative. I would prefer a more efficient solution in the spirit of R, where vectorization is superior to looping.
- The algorithms currently iterate over every
.EntireRow
(or.EntireColumn
) of every area inrange
. I would prefer to iterate directly over every unique row (or column) inrange
, without having to first consolidate (viaApplication.Union()
) the rows (or columns) from every area. - Those algorithms safeguard against doubly counting cells in overlapping areas like those (dark blue) in
Irregular
(below). However, in large areas with dense overlap, this approach could iterate redundantly over each of a thousand cells, and the performance would bog down.
Code
I have divided the code between "Exposed Functions" for normal use, and the "Helper Functions" that support them.
Exposed Functions
' Filter a range and return it by reference rather than value.
Public Function FILTER_RANGE(range As range, include As Variant, Optional by_column As Boolean = False) As range
' Coerce filter from range to array, if necessary.
If TypeOf include Is range Then
include = RANGE_TO_ARRAY(include)
End If
' Dispatch to helper functions, which filter by row or column as desired.
If by_column Then
Set FILTER_RANGE = FILTER_RANGE_BY_COLUMNS(range, include)
Else
Set FILTER_RANGE = FILTER_RANGE_BY_ROWS(range, include)
End If
End Function
' Extract as text the full address for a given range. Used in Excel to validate the results from FILTER_RANGE().
Public Function RANGE_ADDRESS(range As range) As String
If range Is Nothing Then
RANGE_ADDRESS = ""
' ElseIf range Is Null Then
' RANGE_ADDRESS = ""
Else
RANGE_ADDRESS = range.Address
End If
End Function
Helper Functions
' .
Public Function COUNT_ALL_ROWS(range As range, Optional unique As Boolean = True) As LongLong
Dim consolidatedRows As range
COUNT_ALL_ROWS = 0
Set consolidatedRows = Nothing
' Consolidate all relevant rows as desired.
If unique Then
Set consolidatedRows = GET_ALL_ROWS(range)
Else
Set consolidatedRows = range
End If
' Count the rows.
For Each area In consolidatedRows.Areas
COUNT_ALL_ROWS = COUNT_ALL_ROWS + area.rows.CountLarge
Next
End Function
' .
Public Function COUNT_ALL_COLUMNS(range As range, Optional unique As Boolean = True) As LongLong
Dim consolidatedColumns As range
COUNT_ALL_COLUMNS = 0
Set consolidatedColumns = Nothing
' Consolidate all relevant columns as desired.
If unique Then
Set consolidatedColumns = GET_ALL_COLUMNS(range)
Else
Set consolidatedColumns = range
End If
' Count the columns.
For Each area In consolidatedColumns.Areas
COUNT_ALL_COLUMNS = COUNT_ALL_COLUMNS + area.Columns.CountLarge
Next
End Function
' .
Private Function FILTER_RANGE_BY_ROWS(range As range, include As Variant) As range
' Capture the sizes of the range and the filtering array.
rangeSize = COUNT_ALL_ROWS(range, True)
' Check if the filter is an array or a scalar.
filterIsArray = IsArray(include)
' Proceed as normal if the filter is an array...
If filterIsArray Then
filterSize = GET_ARRAY_LENGTH(include)
' ...or throw an error if the filter is not a boolean scalar...
ElseIf VarType(include) <> vbBoolean Then
Err.Raise vbObjectError + 513
' ...and otherwise return an empty range if the scalar (False) excludes everything...
ElseIf include = False Then
Set FILTER_RANGE_BY_ROWS = Nothing
Exit Function
' ...or return the original range if the scalar (True) includes everything.
ElseIf include = True Then
Set FILTER_RANGE_BY_ROWS = range
Exit Function
End If
' Throw an error if that filter is an array that does not correspond in size to the range.
If (rangeSize <> filterSize) And filterIsArray Then
Err.Raise vbObjectError + 513
End If
' Prepare iterators.
Dim filterIndex As Integer
filterIndex = 0
Dim rangeRows As range
Set rangeRows = GET_ALL_ROWS(range)
Set FILTER_RANGE_BY_ROWS = Nothing
' Iterate over every distinct row:
For Each area In rangeRows.Areas
For Each singleRow In area.rows
' Increment the index.
filterIndex = filterIndex + 1
' If the corresponding filter value is TRUE, then keep this row.
If include(filterIndex, 1) = True Then
If FILTER_RANGE_BY_ROWS Is Nothing Then
Set FILTER_RANGE_BY_ROWS = singleRow
Else
Set FILTER_RANGE_BY_ROWS = Application.Union(FILTER_RANGE_BY_ROWS, singleRow)
End If
End If
Next
Next
' Keep the range that overlaps with the rows that were kept.
If FILTER_RANGE_BY_ROWS Is Nothing Then
Set FILTER_RANGE_BY_ROWS = Nothing
Else
Set FILTER_RANGE_BY_ROWS = Application.Intersect(range, FILTER_RANGE_BY_ROWS)
End If
End Function
' .
Private Function FILTER_RANGE_BY_COLUMNS(range As range, include As Variant) As range
' Capture the sizes of the range and the filtering array.
rangeSize = COUNT_ALL_COLUMNS(range, True)
' Check if the filter is an array or a scalar.
filterIsArray = IsArray(include)
' Proceed as normal if the filter is an array...
If filterIsArray Then
filterSize = GET_ARRAY_LENGTH(include)
' ...or throw an error if the filter is not a boolean scalar...
ElseIf VarType(include) <> vbBoolean Then
Err.Raise vbObjectError + 513
' ...and otherwise return an empty range if the scalar (False) excludes everything...
ElseIf include = False Then
Set FILTER_RANGE_BY_COLUMNS = Nothing
Exit Function
' ...or return the original range if the scalar (True) includes everything.
ElseIf include = True Then
Set FILTER_RANGE_BY_COLUMNS = range
Exit Function
End If
' Throw an error if that filter is an array that does not correspond in size to the range.
If (rangeSize <> filterSize) And filterIsArray Then
Err.Raise vbObjectError + 513
End If
' Prepare iterators.
Dim filterIndex As Integer
filterIndex = 0
Dim rangeColumns As range
Set rangeColumns = GET_ALL_COLUMNS(range)
Set FILTER_RANGE_BY_COLUMNS = Nothing
' Iterate over every distinct column:
For Each area In rangeColumns.Areas
For Each singleColumn In area.Columns
' Increment the index.
filterIndex = filterIndex + 1
' If the corresponding filter value is TRUE, then keep this column.
If include(filterIndex, 1) = True Then
If FILTER_RANGE_BY_COLUMNS Is Nothing Then
Set FILTER_RANGE_BY_COLUMNS = singleColumn
Else
Set FILTER_RANGE_BY_COLUMNS = Application.Union(FILTER_RANGE_BY_COLUMNS, singleColumn)
End If
End If
Next
Next
' Keep the range that overlaps with the columns that were kept.
If FILTER_RANGE_BY_COLUMNS Is Nothing Then
Set FILTER_RANGE_BY_COLUMNS = Nothing
Else
Set FILTER_RANGE_BY_COLUMNS = Application.Intersect(range, FILTER_RANGE_BY_COLUMNS)
End If
End Function
' .
Private Function GET_ALL_ROWS(range As range) As range
Set GET_ALL_ROWS = Nothing
For Each area In range.Areas
If GET_ALL_ROWS Is Nothing Then
Set GET_ALL_ROWS = area.EntireRow
Else
Set GET_ALL_ROWS = Application.Union(GET_ALL_ROWS, area.EntireRow)
End If
Next
End Function
' .
Private Function GET_ALL_COLUMNS(range As range) As range
Set GET_ALL_COLUMNS = Nothing
For Each area In range.Areas
If GET_ALL_COLUMNS Is Nothing Then
Set GET_ALL_COLUMNS = area.EntireColumn
Else
Set GET_ALL_COLUMNS = Application.Union(GET_ALL_COLUMNS, area.EntireColumn)
End If
Next
End Function
' .
Private Function RANGE_TO_ARRAY(range As Variant) As Variant
' .
RANGE_TO_ARRAY = range.Value2
' |----|
' Use ".Value2" for better performance.
End Function
' .
Private Function GET_ARRAY_LENGTH(a As Variant) As Integer
If IsEmpty(a) Then
GET_ARRAY_LENGTH = 0
Else
GET_ARRAY_LENGTH = UBound(a) - LBound(a) + 1
End If
End Function
FILTER_RANGE(range, include_rows, [include_columns])
. \$\endgroup\$