Automatically hide corresponding rows based on cell value - excel

Question

I tried writing macros wherein rows are hidden based on a cell value (which is a Data Validation dropdown):
Using the following code:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = Range("C15") Then
BeginRow = 17
EndRow = 25
ChkCol = 4
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
It is doing the thing I need but the problems I'm facing are, it is taking time for any change in C15 (actual data has around 100 rows) and also when I'm trying to make any changes in rest of the sheet, it throws an error -
"Run-time error '13': Type Mismatch".
I have no macros experience and I'm not sure what I'm doing wrong. Could you please help me correct the code. If there is a better way to achieve the same task in a more efficient way, please do let me know.

Answer 1

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

Answer 2

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.

Answer 3

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.

Answer 4

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