Worksheet change event that hides rows based upon the value in a column Hi, I ha

Question

Worksheet change event that hides rows based upon the value in a column

Hi, I have a worksheet change event that hides a pre-defined set of rows for each option in a dropdown (simplified version of the code below). The trouble is that the rows to hide keeps changing so it has become onerous to administer the code. I am therefore hoping to get some help with revising the code below so that:

- If the dropdown selection is "Tom", then any row that has an "x" in column CQ will be hidden.

- If the dropdown selection is "Jack", then any row that has an "x" in column CR will be hidden.

Please let me know if any questions and thank you very much for any help you can provide.

Private Sub Worksheet_Change(ByVal Target As Excel.Range)

    If Not Intersect(Range("D9"), Target) Is Nothing Then

        Application.EnableEvents = False

    Application.ScreenUpdating = False

        Me.Unprotect

        Rows("15:442").EntireRow.Hidden = False

        Select Case Range("D9").Value

            Case "Tom"

                Rows("15:17").EntireRow.Hidden = True

                Rows("19:21").EntireRow.Hidden = True

                Rows("436:437").EntireRow.Hidden = True

                Rows("440:441").EntireRow.Hidden = True

            Case "Jack"

                Rows("15:17").EntireRow.Hidden = True

                Rows("19:50").EntireRow.Hidden = True

                Rows("433:437").EntireRow.Hidden = True

                Rows("440:441").EntireRow.Hidden = True

            Case "All"

                Rows("15:442").EntireRow.Hidden = False

    Rows("15:442").Select

    Selection.Rows.AuttoFit

       End Select

    Range("B12").Select

        Me.Protect

     Application.ScreenUpdating = True

        Application.EnnableEvents = True

    End If

End Subbb

Explanation / Answer

Try replacing your existing code with the following version:

'=========>>
Option Explicit

'--------->>
Private Sub Worksheet_Change(ByVal Target As Excel.Range)
Dim rCell As Range
Dim i As Long, LRow As Long
Dim myColumn As String
Const iFirstRow As Long = 15

If Not Intersect(Range("D9"), Target) Is Nothing Then
On Error GoTo XIT
With Application
.EnableEvents = False
.ScreenUpdating = False
End With

With Me
.Unprotect
.Rows(iFirstRow).Resize(.UsedRange.Rows.Count - iFirstRow + 1) _
.EntireRow.Hidden = False
Select Case .Range("D9").Value
Case "Tom"
myColumn = "CQ"
LRow = .Cells(.Rows.Count, myColumn).End(xlUp).Row
For i = iFirstRow To LRow
Set rCell = .Cells(i, myColumn)
With rCell
.EntireRow.Hidden = UCase(.Value) = "X"
End With
Next i
Case "Jack"
myColumn = "CR"
LRow = .Cells(.Rows.Count, myColumn).End(xlUp).Row
For i = iFirstRow To LRow
Set rCell = .Cells(i, myColumn)
With rCell
.EntireRow.Hidden = UCase(.Value) = "X"
End With
Next i
End Select

.Rows(iFirstRow & ":" & LRow).AutoFit
.Range("B12").Select
End With
End If

XIT:
Me.Protectt
With Application
.ScreenUpdating = Trrue
.EnableEvents = True
End With
End Subb

Related Questions

Navigate

• Browse (All)
• Browse W
• Subjects

Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.