View Full Version : How to make multiple, non adjacent cells hidden based on cell value code
1992Froggie
02-16-2018, 07:35 AM
I have a spread sheet that I want to hide multiple rows, some of them are not adjacent, and I am basically new to coding in excel. I want several rows to hide based on the value of B2, and when B2 changes, I want some of those rows to show, and others to hide, all variable on the value of B2. I have been banging my head on the wall trying to figure this out, even though I know it is probably basic coding. 
I want the following rows hidden for each value in B2:
ACSA - 24, 25, 35, 36, 57, 58, 60, all other rows not hidden
CSA - 57, 58, 60, all other rows not hidden
ASA - 24, 25, 30, 31, 35, 36, 50, 57, 58, 59, 60, all other rows not hidden
ACA - 24, 25, 30, 31, 35, 36, 50, 59, 60, all other rows not hidden
SASA - 24, 25, 30, 31, 35, 36, 50, 57, 58, 59, 60, all other rows not hidden
Please Select Role Code - all rows not hidden
This is what I have so far:
Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Activate
If Not Application.Intersect(Range("B2"), Range(Target.Address)) Is Nothing Then
Select Case Target.Value
Case Is = "ACSA": Rows("35:36").EntireRow.Hidden = True
Case Is = "CSA": Rows("35:36").EntireRow.Hidden = False
Case Is = "ASA": Rows("35:36").EntireRow.Hidden = True
Case Is = "ACA": Rows("35:36").EntireRow.Hidden = True
Case Is = "SASA": Rows("35:36").EntireRow.Hidden = False
Case Is = "Please Select Role Code": Rows("35:36").EntireRow.Hidden = False
End Select
End If
If Not Application.Intersect(Range("D38"), Range(Target.Address)) Is Nothing Then
Select Case Target.Value
Case Is = "Select Answer": Rows("39:47").EntireRow.Hidden = False
Case Is = "Yes": Rows("39:47").EntireRow.Hidden = True
Case Is = "No": Rows("39:47").EntireRow.Hidden = False
Case Is = "NA": Rows("39:47").EntireRow.Hidden = True
End Select
End If
End Sub
I would really appreciate it! I am so lost at this point :banghead::banghead:
Paul_Hossler
02-16-2018, 08:40 AM
1. Welcome to the Forum - suggest you take a look at the FAQs (in my sig)
2. I added CODE tags to format the macro for you - you can use the [#] icon to insert CODE tags and paste the macro between
3. No sure about the interplay between the two cells but something like this maybe on the code sheet for the worksheet
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim v As Variant
    Dim r As Range
    Dim Rows39_47 As Boolean
    
    Set r = Target.Cells(1, 1)
    
    If Len(r.Value) = 0 Then Exit Sub  '   catch a Clear
    If Not Application.Intersect(Range("B2"), Target) Is Nothing Then
    
        Application.ScreenUpdating = False
                    
        Rows39_47 = Me.Rows("39:47").Hidden
        Me.Rows.Hidden = False
        Me.Rows("39:47").Hidden = Rows39_47
        
        Select Case UCase(r.Value)
            Case Is = "ACSA"
                For Each v In Array(24, 25, 35, 36, 57, 58, 60)
                    Me.Rows(v).Hidden = True
                Next
            Case Is = "CSA"
                For Each v In Array(57, 58, 60)
                    Me.Rows(v).Hidden = True
                Next
            Case Is = "ASA"
                For Each v In Array(24, 25, 30, 31, 35, 36, 50, 57, 58, 59, 60)
                    Me.Rows(v).Hidden = True
                Next
            Case Is = "ACA"
                For Each v In Array(24, 25, 30, 31, 35, 36, 50, 59, 60)
                    Me.Rows(v).Hidden = True
                Next
            Case Is = "SASA"
                For Each v In Array(24, 25, 30, 31, 35, 36, 50, 57, 58, 59, 60)
                    Me.Rows(v).Hidden = True
                Next
            Case Is = "PLEASE SELECT ROLE CODE"
                '   empty for completeness
        End Select
        
        Application.ScreenUpdating = True
        
    
    ElseIf Not Application.Intersect(Range("D38"), Target) Is Nothing Then
    
        Application.ScreenUpdating = False
        
        Select Case UCase(r.Value)
            Case Is = "SELECT ANSWER"
                Me.Rows("39:47").Hidden = False
            Case Is = "YES"
                Me.Rows("39:47").Hidden = True
            Case Is = "NO"
                Me.Rows("39:47").Hidden = False
            Case Is = "NA"
                Me.Rows("39:47").Hidden = True
        End Select
        
        Application.ScreenUpdating = True
    
    End If
    
End Sub
This is Pauls's Code. I refactored it to reflect my own preference for NOT overloading an Event sub.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    If Len(Target.Value) = 0 Then Exit Sub  '   catch a Clear
    If Target.Address = "$B$2" Then HideB2 Target
    If Target.Address = "$D$38" Then HideD38 Target
    
End Sub
Private Sub HideB2(Target As Range)
Dim v, ACSA, CSA, ASA, ACA, SASA
  ACSA = Array(24, 25, 35, 36, 57, 58, 60)
  CSA = Array(57, 58, 60)
  ASA = Array(24, 25, 30, 31, 35, 36, 50, 57, 58, 59, 60)
  ACA = Array(24, 25, 30, 31, 35, 36, 50, 59, 60)
  SASA = ASA
  
  Rows.Hidden = False
        Select Case UCase(Target.Value)
            Case Is = "ACSA"
                For Each v In ACSA
                    Me.Rows(v).Hidden = True
                Next
            Case Is = "CSA"
                For Each v In CSA
                    Me.Rows(v).Hidden = True
                Next
            Case Is = "ASA"
                For Each v In ASA
                    Me.Rows(v).Hidden = True
                Next
            Case Is = "ACA"
                For Each v In ACA
                    Me.Rows(v).Hidden = True
                Next
            Case Is = "SASA"
                For Each v In SASA
                    Me.Rows(v).Hidden = True
                Next
            Case Is = "PLEASE SELECT ROLE CODE"
                '   empty for completeness
            Case Else
        End Select
        
        Application.ScreenUpdating = True
        
        HideD38 Range("D38")
End Sub
Private Sub HideD38(Target As Range)
        Application.ScreenUpdating = False
        
        Select Case UCase(Target.Value)
            Case Is = "SELECT ANSWER"
                Me.Rows("39:47").Hidden = False
            Case Is = "YES"
                Me.Rows("39:47").Hidden = True
            Case Is = "NO"
                Me.Rows("39:47").Hidden = False
            Case Is = "NA"
                Me.Rows("39:47").Hidden = True
        End Select
        
        Application.ScreenUpdating = True
End Sub
Paul_Hossler
02-16-2018, 09:50 AM
SamT -- 
1. Nothing wrong with the refactoring
2. Be advised that after you unhide all Rows
Rows.Hidden = False
If Target.Address = "$D$38" Then HideD38 Target
you might have to hide someD38 rows, even if D38 wasn't the Target
That was why I have to remember the D38 rows Hidden status, unhide all Rows, hide/unhide the D38 rows, and then hide the appropriate B2 rows
you might have to hide someD38 rows, even if D38 wasn't the Target
Rows.Hidden = False
'
'Handle B2 Rows
'
HideD38 Range("D38")
Paul_Hossler
02-16-2018, 10:24 AM
Sam - 1
Paul - 0
1992Froggie
02-19-2018, 02:55 PM
Hi All,
Thanks for your help the following code is working for me that Paul published, it works great, the only thing i need added is I just need to add the following, if:
D12 is value Yes - Rows 12-17 are not hidden
D12 value is No - Rows 12-17 are hidden
D12 value is NA - Rows 12-17 are hidden
D12 value is Select Answer - Rows 12-17 are not hidden
I was trying to copy the information for the coding of rows 88-47 and add this, but I am not doing it right. Thanks for being patient with me. This code I got from Paul works great, I just need to incorporate the 12-17 row info above, and I will be all done! Again thanks so much!!
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim v As Variant
    Dim r As Range
    Dim Rows39_47 As Boolean
    
    Set r = Target.Cells(1, 1)
    
    If Len(r.Value) = 0 Then Exit Sub  '   catch a Clear
    If Not Application.Intersect(Range("B2"), Target) Is Nothing Then
    
        Application.ScreenUpdating = False
                    
        Rows39_47 = Me.Rows("39:47").Hidden
        Me.Rows.Hidden = False
        Me.Rows("39:47").Hidden = Rows39_47
        
        Select Case UCase(r.Value)
            Case Is = "ACSA"
                For Each v In Array(24, 25, 35, 36, 57, 58, 60)
                    Me.Rows(v).Hidden = True
                Next
            Case Is = "CSA"
                For Each v In Array(57, 58, 60)
                    Me.Rows(v).Hidden = True
                Next
            Case Is = "ASA"
                For Each v In Array(24, 25, 30, 31, 35, 36, 50, 57, 58, 59, 60)
                    Me.Rows(v).Hidden = True
                Next
            Case Is = "ACA"
                For Each v In Array(24, 25, 30, 31, 35, 36, 50, 59, 60)
                    Me.Rows(v).Hidden = True
                Next
            Case Is = "SASA"
                For Each v In Array(24, 25, 30, 31, 35, 36, 50, 57, 58, 59, 60)
                    Me.Rows(v).Hidden = True
                Next
            Case Is = "PLEASE SELECT ROLE CODE"
                '   empty for completeness
        End Select
        
        Application.ScreenUpdating = True
    
    ElseIf Not Application.Intersect(Range("D38"), Target) Is Nothing Then
    
        Application.ScreenUpdating = False
        
        Select Case UCase(r.Value)
            Case Is = "SELECT ANSWER"
                Me.Rows("39:47").Hidden = False
            Case Is = "YES"
                Me.Rows("39:47").Hidden = True
            Case Is = "NO"
                Me.Rows("39:47").Hidden = False
            Case Is = "NA"
                Me.Rows("39:47").Hidden = True
        End Select
        
        Application.ScreenUpdating = True
    End If
End Sub
Paul_Hossler
02-20-2018, 08:53 AM
I just added a ElseIf at the end and another Rows12_17 Boolean to track status
However ...
D12 is value Yes - Rows 12-17 are not hidden
D12 value is No - Rows 12-17 are hidden
D12 value is NA - Rows 12-17 are hidden
D12 value is Select Answer - Rows 12-17 are not hidden
I was trying to copy the information for the coding of rows 88-47 and add this, but I am not doing it right. Thanks for being patient with me. This code I got from Paul works great, I just need to incorporate the 12-17 row info above, and I will be all done! Again thanks so much!!
... if Row 12 is Hidden because of  D12 = "No", how would you put in "Yes"? 
 
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim v As Variant
    Dim r As Range
    Dim Rows39_47 As Boolean, Rows12_17 As Boolean
    
    Set r = Target.Cells(1, 1)
    
    If Len(r.Value) = 0 Then Exit Sub  '   catch a Clear
    If Not Application.Intersect(Range("B2"), Target) Is Nothing Then
    
        Application.ScreenUpdating = False
                    
        Rows39_47 = Me.Rows("39:47").Hidden
        Rows12_17 = Me.Rows("12:17").Hidden
        Me.Rows.Hidden = False
        Me.Rows("39:47").Hidden = Rows39_47
        Me.Rows("12:17").Hidden = Rows12_17
        
        Select Case UCase(r.Value)
            Case Is = "ACSA"
                For Each v In Array(24, 25, 35, 36, 57, 58, 60)
                    Me.Rows(v).Hidden = True
                Next
            Case Is = "CSA"
                For Each v In Array(57, 58, 60)
                    Me.Rows(v).Hidden = True
                Next
            Case Is = "ASA", "SASA"
                For Each v In Array(24, 25, 30, 31, 35, 36, 50, 57, 58, 59, 60)
                    Me.Rows(v).Hidden = True
                Next
            Case Is = "ACA"
                For Each v In Array(24, 25, 30, 31, 35, 36, 50, 59, 60)
                    Me.Rows(v).Hidden = True
                Next
            Case Is = "PLEASE SELECT ROLE CODE"
                '   empty for completeness
        End Select
        
        Application.ScreenUpdating = True
    
    ElseIf Not Application.Intersect(Range("D38"), Target) Is Nothing Then
    
        Application.ScreenUpdating = False
        
        Select Case UCase(r.Value)
            Case Is = "SELECT ANSWER", "NO"
                Me.Rows("39:47").Hidden = False
            Case Is = "YES", "NA"
                Me.Rows("39:47").Hidden = True
            Case Else
                Me.Rows("39:47").Hidden = False
        End Select
        
        Application.ScreenUpdating = True
    
    
    ElseIf Not Application.Intersect(Range("D12"), Target) Is Nothing Then
    
        Application.ScreenUpdating = False
        
        Select Case UCase(r.Value)
            Case Is = "NO", "NA"
                Me.Rows("12:17").Hidden = True
            Case Is = "YES", "SELECT ANSWER"
                Me.Rows("12:17").Hidden = False
            Case Else
                Me.Rows("12:17").Hidden = False
        End Select
        
        Application.ScreenUpdating = True
    End If
End Sub
 
I polished this a bit: combined Case's that had same result, and added a Case Else just in Case (pun intended)
Powered by vBulletin® Version 4.2.5 Copyright © 2025 vBulletin Solutions Inc. All rights reserved.