CODEWITHSUNDEEP
excelvba
Srikiran
Srikiran

Reputation: 21

Automatically hide corresponding rows based on cell value

I tried writing macros wherein rows are hidden based on a cell value (which is a Data Validation dropdown):

Example Data

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.

Upvotes: 0

Views: 330

Answers (4)

QHarr
QHarr

Reputation: 84465

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.

Filter

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

Upvotes: 0

Storax
Storax

Reputation: 12167

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.

Upvotes: 0

chris neilsen
chris neilsen

Reputation: 53135

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

Upvotes: 1

Lee Mac
Lee Mac

Reputation: 16015

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.

Upvotes: 0

Related Questions