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