SelRows()
Post date: Aug 15, 2014 4:36:40 PM
Select Multiple Rows with Multiple Criteria, Colors or Icons
Here is a nifty routine to select table rows based on multiple criteria which can include values as well as cell colors, font colors and icons.
Learnings for VBA Beginners:
VBA beginners can see how some slightly more advanced VBA features are used such as:
Passing an undefined number of parameters with ParamArray
Using SpecialCells
Using VBA's Split function
Detecting Arrays and dealing with arrays IN arrays
Setting XL's AutoFilter function
Using a Class object
Example Uses
This is a 'Swiss army knife' type of routine. It can help us in so many ways such as find a row or rows where a column or columns contain:
A specific value (Find in Table1 where the Name column contains "Rick")
Set oRange = SelRows("Table1", "Name", xlAnd,"Rick")
An array or list of values (and select row(s))
SelRows("Table1", "Name", xlFilterValues, Array("Rick","Bob")).Select
SelRows("Table1", "Name", xlFilterValues, "Rick,Bob").Select
Values using wildcard criteria (and delete row(s))
SelRows("Table1", "Name", xlAnd,"Ri*").Delete
Cells of a specified background color (and change "Status" column for each)
InterSect([Table1[Status]], _
SelRows("Table1", "Status", xlFilterCellColor, RGB(255,0,0))) = "INVALID!"
Or any combination of the above (and copy to a different worksheet)
SelRows("Table1", "Name", xlAnd, "Rick",
"Status", xlFilterCellColor, RGB(255,0,0)).Copy([Sheet2!A4])
and more!
The Syntax
This routine returns a Range object and accepts as many criteria over as many columns as desired:
SelRows [Table Name, a Range in a Table or a ListObject], _
[Column name or number to search], _
[Comparison operator (see operator list)], _
[Criteria to match], _
Optional [[Next column name or number to search], _
[Next comparison operator], _
[Next criteria to match]]... (Repeat as needed)
Because SelRows returns a range object, we can do anything to the results we can do to any range and very efficiently. When I use this to to delete rows scattered throughout a table I always think back to the days of looping backwards through rows (because looping forwards caused all kinds of problems) and how long it took... and I get a little tingle. SelRows is so much better.
Operator List
SelRows is basically a front end to the XLs AutoFilter function and accepts all of the AutoFilter's operators (from msdn.microsoft.com/en-us/library/bb240957(v=office.12).aspx):
The Code
I encourage readers to download the code rather than copy it from the text below. The code below is provided for discussion purposes and may not be the latest version. Read on to learn how to download the code.
SelRows is actually split across two routines: SelRows and SetFilter. They can be combined if you prefer. I did it for functional decompositioning which is jargon for breaking problems into smaller tasks so we can concentrate on one problem at a time. SelRows also uses routine cListObject and class clsSettings.
cListObject takes a parameter and 'coerces' it into a ListObject. The allows SelRows to be more accepting for how we identify which table we want to filter. We can identify tables by their name, by any cell within the table, or by the table itself. cListObject and SelRows are part of my general purpose library; thus, the code for both are stored in my module modGeneral.bas. Right click here to here to download (use Save As) the latest version of modGeneral.bas.
clsSettings remembers our application's settings, such as ScreenUpdating and EnableEvents, turns them off so users won't see strange things happening with their screen and so our routine will run faster, and then restores the application's settings back to what they were originally. The class works almost magically. This line saves our settings: Set oSettings = New clsSettings. When our routine ends, oSettings is removed from memory (along with all other variables scoped to this routine) which causes clsSettings to run its Terminate routine which restores our application settings. Right click here to download (use Save As) the lastest version of clsSettings.cls.
Once the module and class are downloaded we can use the VBE's Import function (Ctrl+M or use menu path File > Import File) to load them into our project and start using them.
Function SelRows
Below is the code for SelRows. It uses my standard template and error handling. If you'd like to know more about them, click here to download and read Error_Handling.PDF.
SelRows accepts any number of Column, Operator, and Key criteria. Most beginners have never used the ParamArray keyword which makes passing a dynamically expanding parameter list possible. For more on ParamArray click here for MSDNs reference article and here for Chip Pearson's explanations. NOTE! ParamArray is always passed ByVal and is always Optional and because I declared vAddKeys() As Variant we can use IsMissing(vAddKeys()) to determine if we have any additional criteria to deal with. It is also possible that the first element in vAddKeys() is not a single element but an array. We use IsArray(vAddKeys(lBound(vAddKeys))) to test it. If it is an array, we get ALL of our additional criteria from the first element.
Now that we have all of our parameters sorted out, we call upon SetFilter to filter our table. Once filtered, we use Set SelRows = .DataBodyRange.SpecialCells(xlCellTypeVisible) to return only the cells in the table's data left visible by the filter.
Before we finish, we restore the table to its unfiltered stated and end the subroutine. Remember, ending this subroutine causes all locally dimensioned (scoped) variables to be removed from memory which causes clsSettings to run its Terminate routine which restores all application settings.
Public Function SelRows(ByVal vTable As Variant, _
ByVal vKeyCol As Variant, _
ByVal lKeyOpr As XlAutoFilterOperator, _
ByVal vKeyVal As Variant, _
ParamArray vAddKeys() As Variant) As Range
' Description:Select a row or rows in a table based on key values
' Inputs: vTable Table (Name,Range,or ListObject) containing rows to Select
' vKeyCol First column to search
' lKeyOpr Comparison Operator
' vKeyVal Value to find in first column
' vAddKeys (Optional) Additional column/operator/key combinations
' Outputs: Me Success: Range(s) of rows matching criteria
' Failure: Nothing
' Requisites: Function: modGeneral.cListObject()
' me.SetFilter()
' Classes: clsSettings
' References: msdn.microsoft.com/en-us/library/bb240957(v=office.12).aspx
' Example: ?SelRows("Skin", 2, xlAnd, "FONT").Address
' SelRows("DET_Properties", 1, xlAnd, "DET").Delete
' SelRows("DET_Properties", 2, "ID*").Select
' ?SelRows("Table1", 3,xlFilterCellColor,RGB(255,0,0), "A",xlOr, "4,8").address
' Date Ini Modification
' 08/14/14 CWH Initial Programming
' Declarations
Dim sRoutine As String 'Routine's Name
Dim oLO As ListObject 'Table being searched
Dim n As Long 'Generic Counter
Dim vArray As Variant 'Parameter Array
Dim oSettings As clsSettings 'Application Settings
' Error Handling Initialization
On Error GoTo ErrHandler
sRoutine = cModule & ".SelRows"
Set oSettings = New clsSettings
Set SelRows = Nothing
' Check Inputs and Requisites
Set oLO = cListObject(vTable)
If oLO Is Nothing Then Err.Raise DspError, , "Table missing"
If Not IsMissing(vAddKeys()) Then _
If IsArray(vAddKeys(lBound(vAddKeys))) Then _
vArray = vAddKeys(lBound(vAddKeys)) Else _
vArray = vAddKeys
' Procedure
With oLO
.Range.AutoFilter
SetFilter oRange:=.Range, _
lField:=.ListColumns(vKeyCol).Index, _
lOperator:=lKeyOpr, _
vCriteria:=vKeyVal
If Not IsMissing(vAddKeys()) Then
For n = 0 To UBound(vArray) Step 3
SetFilter oRange:=.Range, _
lField:=.ListColumns(vArray(n)).Index, _
lOperator:=vArray(n + 1), _
vCriteria:=vArray(n + 2)
Next
End If
Set SelRows = .DataBodyRange.SpecialCells(xlCellTypeVisible)
.Range.AutoFilter
End With
ErrHandler:
Select Case Err.Number
Case Is = NoError: 'Do nothing
Case Is = 1004: Resume Next 'No Cells Selected
Case Else:
Select Case DspErrMsg(sRoutine)
Case Is = vbAbort: Stop: Resume 'Debug mode - Trace
Case Is = vbRetry: Resume 'Try again
Case Is = vbIgnore: 'End routine
End Select
End Select
End Function
Function SetFilter
Below is the code for SetFilter. It too uses my standard template and error handling. SetFilter's job is to determine from lOperator how to set XL's AutoFilter function. For more on AutoFilter click here for MSDN's reference.
Private Function SetFilter(ByVal oRange As Range, _
ByVal lField As Long, _
ByVal lOperator As XlAutoFilterOperator, _
ByVal vCriteria As Variant) As Boolean
' Description:Set AutoFilter for a single field and criteria
' Inputs: oRange Range containing rows to Select
' lField Column number to search
' lOperator Comparison Operator
' vCriteria Value(s) to find
' Outputs: Me Success/Failure
' Requisites: *None
' Example: ?SetFilter([Table1], 2, xlAnd, "FONT").Address
' Date Ini Modification
' 08/14/14 CWH Initial Programming
' Declarations
Dim sRoutine As String 'Routine's Name
Dim vArray As Variant
' Error Handling Initialization
On Error GoTo ErrHandler
sRoutine = cModule & ".SetFilter"
SetFilter = Failure
' Procedure
With oRange
Select Case lOperator
Case Is = xlFilterValues
If IsArray(vCriteria) Then vArray = vCriteria Else vArray = Split(vCriteria, ",")
.AutoFilter Field:=lField, _
Operator:=lOperator, _
Criteria1:=vArray
Case Is = xlOr, xlAnd
If IsArray(vCriteria) Then vArray = vCriteria Else vArray = Split(vCriteria, ",")
.AutoFilter Field:=lField, _
Operator:=lOperator, _
Criteria1:=vArray(LBound(vArray)), _
Criteria2:=vArray(UBound(vArray))
Case Else
.AutoFilter Field:=lField, _
Operator:=lOperator, _
Criteria1:=vCriteria
End Select
End With
SetFilter = Success
ErrHandler:
Select Case Err.Number
Case Is = NoError: 'Do nothing
Case Else:
Select Case DspErrMsg(sRoutine)
Case Is = vbAbort: Stop: Resume 'Debug mode - Trace
Case Is = vbRetry: Resume 'Try again
Case Is = vbIgnore: 'End routine
End Select
End Select
End Function