Automatically hide corresponding rows based on cell value

Looping through a few 100 (or even a few thousand) rows checking the hidden property will run fast enough. Key points are to limit the checking to only the required cells, and do the Hide/Unhide in one operation (this is the slow bit if done a row at a time)

Using the logic:

• If Cell C15 changes, check the whole list, or
• If one or more cells change in the list D17:D25 (or larger) process only changed cells
• Build a reference to rows that must change hidden state, and set the Hidden property for the whole range

This code runs virtually instantly on a List range of a few 1000 rows

Private Sub Worksheet_Change(ByVal Target As Range) Dim rng As Range Dim cl As Range Dim rTest As Range, vTest As Variant Dim rList As Range Dim rHide As Range, rUnhide As Range On Error GoTo EH Application.EnableEvents = False Application.ScreenUpdating = False Set rTest = Me.Cells(15, 3) ' Cell to compare to Set rList = Me.Range("D17:D25") ' List of cells to compare to the Test cell If Not Application.Intersect(Target, rTest) Is Nothing Then ' Test cell has changed, so process whole list Set rng = rList Else ' Only process changed cells in the list Set rng = Application.Intersect(Target, rList) End If If Not rng Is Nothing Then ' there is somthing to process vTest = rTest.Value For Each cl In rng.Cells If cl.EntireRow.Hidden Then ' the row is already hidden If cl.Value = vTest Then ' and it should be visible, add it to the Unhide range If rUnhide Is Nothing Then Set rUnhide = cl Else Set rUnhide = Application.Union(rUnhide, cl) End If End If Else ' the row is already visible If cl.Value <> vTest Then ' and it should be hidden, add it to the Hide range If rHide Is Nothing Then Set rHide = cl Else Set rHide = Application.Union(rHide, cl) End If End If End If Next ' do the actual hiding/unhiding in one go (faster) If Not rUnhide Is Nothing Then rUnhide.EntireRow.Hidden = False End If If Not rHide Is Nothing Then rHide.EntireRow.Hidden = True End If End If EH: Application.EnableEvents = True Application.ScreenUpdating = True End Sub 

Using the Find method may be quicker for you:

Private Sub Worksheet_Change(ByVal Target As Range) On Error GoTo exitHandler Application.EnableEvents = False If Target.Address = "$C$15" Then Rows("17:25").EntireRow.Hidden = True Dim rng As Range Set rng = Me.Range("D17:D25").Find(What:=Target.Value, LookAt:=xlWhole) If Not rng Is Nothing Then rng.EntireRow.Hidden = False End If exitHandler: Application.EnableEvents = True End Sub 

Rather than iterating over every row one-by-one, this version first hides all rows in the range, and then unhides the appropriate row, if found.

In order to prevent the error you need to use the error handler. The error will occur in case you select more than one cell and try to delete them

 Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Const BeginRow = 17 Const EndRow = 25 Const ChkCol = 4 Dim RowCnt As Long On Error GoTo exitHandler Application.EnableEvents = False If Target = Range("C15") Then For RowCnt = BeginRow To EndRow If Cells(RowCnt, ChkCol).Value = Cells(15, 3).Value Then Cells(RowCnt, ChkCol).EntireRow.Hidden = False Else Cells(RowCnt, ChkCol).EntireRow.Hidden = True End If Next RowCnt End If exitHandler: Application.EnableEvents = True End Sub 

EDIT Based on QHarr's idea to use the Autofilter

Private Sub Worksheet_Change(ByVal Target As Range) Const BeginRow = 17 Const EndRow = 25 Const ChkCol = 4 Dim RowCnt As Long On Error GoTo EH 'If you want to prevent error 13 you could uncomment the following line 'If Target.Cells.CountLarge > 1 Then Exit Sub Application.EnableEvents = False If Target = Range("C15") Then Dim filterRange As Range Set filterRange = Range(Cells(BeginRow - 1, ChkCol), Cells(EndRow, ChkCol)) filterRange.AutoFilter filterRange.AutoFilter Field:=1, Criteria1:=Target End If EH: Application.EnableEvents = True End Sub 

EDIT2 The reason for the run-time error 13 is the line Target = Range("C15"). In case you select more than one cell you compare a range with a value because Range("C15") always returnes the value of that cell. As QHarr changed his code after our discussion to Target.Address = Range("C15").Address this error cannot occur any longer.

You could use Autofilter which will be quick.

You can easily change BeginRow, EndRow and ChkCol to adjust range and code still works.

Set to Criteria1:="<>" & Target if you want to show only those not like the selected item.

0.008 seconds for 10000 rows.

Code:

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim BeginRow As Long Dim EndRow As Long Dim ChkCol As Long Dim RowCnt As Long With ActiveSheet If Target.Address = Range("C15").Address Then BeginRow = 17 EndRow = 25 ChkCol = 4 Dim filterRange As Range Set filterRange = .Range(.Cells(BeginRow - 1, ChkCol - 1), .Cells(EndRow, ChkCol)) filterRange.AutoFilter filterRange.AutoFilter Field:=1, Criteria1:= Target End If End With End Sub