Tom’s Tutorials For Excel: Filtering Automatically On Cell Entry

Tom’s Tutorials For Excel: Filtering Automatically On Cell Entry

Here’s a developer’s approach to make things easy for your users who need to filter a range of data, based on a value they enter in a criteria cell. A Worksheet_Change event is utilized on a worksheet that is designed for this purpose, as seen in the picture. When the user enters a value in a pink cell, the table below it will be filtered on that column for that value. If the entered value does not exist in the table, a friendly message box will advise the user.

This is a worksheet level Change event procedure. To install it:
(1) Right-click on your worksheet tab and left-click to select View Code.
(2) Enter or paste the procedure into the large white area that is the worksheet module.
(3) Press Alt+Q to return to the worksheet.

Private Sub Worksheet_Change(ByVal Target As Range)

'Open With structure for Target range object.
With Target

'If the cell being changes is not A2, B2, or C2 then Exit Sub.
If Intersect(Target, Range("A2:C2")) Is Nothing Then Exit Sub
'If more than one cell is attempted to be changed then Exit Sub.
If .Cells.Count > 1 Then Exit Sub

'If the Delete key is pressed, remove AutoFilter.
If IsEmpty(Target) Then
ActiveSheet.AutoFilterMode = False
Exit Sub
End If

'Declare a String type variable for the value that was entered,
'and define the String variable.
Dim strFilter As String
strFilter = .Value
'Declare an Integer type variable for the column of the cell
'that the value was entered, and define the column.
Dim intColumn As Integer
intColumn = .Column
'Declare a Long type variable for the last used row among
'columns A, B, and C, and define that last row number.
Dim LastRow As Long
LastRow = _
Range("A:C").Find(What:="*", After:=Range("A1"), _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

'Close the With structure.
End With

'Do some housekeeping: delete values that may still be in the
'other criteria cells. Set EnableEvents to False and back to True.
Application.EnableEvents = False
If intColumn = 1 Then
Range("B2:C2").ClearContents
ElseIf intColumn = 2 Then
Range("A2, C2").ClearContents
Else
Range("A2:B2").ClearContents
End If
Application.EnableEvents = True

'Before attempting to filter anything, first see if the value
'that was entered exists in the relevant column.
'If it does not, end the procedure and advise the user.
If WorksheetFunction.CountIf(Range(Cells(5, intColumn), _
Cells(LastRow, intColumn)), strFilter) = 0 Then
MsgBox "This column does not contain " & strFilter, 48, "No such animal."
ActiveSheet.AutoFilterMode = False
Exit Sub
End If

'Now, all the reasonable preparations are completed.
'Execute the filter.
ActiveSheet.AutoFilterMode = False
Range(Cells(4, intColumn), _
Cells(LastRow, intColumn)).AutoFilter _
Field:=1, Criteria1:=strFilter

'As a convenience to the user, activate cell A1.
Application.Goto Range("A1"), 1

End Sub