Home > Blockchain >  Combine two Private Sub WorkSheet_Change on one sheet
Combine two Private Sub WorkSheet_Change on one sheet

Time:11-04

I'm hoping that you can help me. I have a workbook that I'm trying to get to do two things based on one drop down selection. In the selection I have 1, 2, or 3. and based on that I'd like to have some rows on that page hide, along with certain sheets.

I was able to get the certain rows to be hidden using the first section. and I was able to get the sheets to hide using the second section. I've tested them in different workbooks and they work. Is there a way that I can combine them?

I really appreciate any insight into this issue

Private Sub Worksheet_Change(ByVal Target As Range)
ActiveSheet.Activate
If Not Application.Intersect(Range("$B$8:$C$8"), Range(Target.Address)) Is Nothing Then
    Select Case Target.Value
    Case Is = "1": Range("A35:A42,A50,A55:A57").EntireRow.Hidden = False
                     Rows("12").EntireRow.Hidden = True
    Case Is = "2": Range("A35:A42,A50,A55:A57").EntireRow.Hidden = True
            Rows("12").EntireRow.Hidden = False
    
    Case Is = "3": Range("A12,A35:A42,A50,A55:A57").EntireRow.Hidden = True

    End Select
End If
End Sub

and

Private Sub Worksheet_Change(ByVal Target As Range)
'Application.Volatile

Select Case Worksheets("INPUT").Range("B8").Value

    Case "1"
        Worksheets("A").Visible = False
        Worksheets("B").Visible = True
        Worksheets("C").Visible = False
        Worksheets("D").Visible = False
        Worksheets("E").Visible = True
        
    Case "2"
        Worksheets("A").Visible = False
        Worksheets("B").Visible = False
        Worksheets("C").Visible = True
        Worksheets("D").Visible = True
        Worksheets("E").Visible = False
        
    Case "3"
        Worksheets("A").Visible = True
        Worksheets("B").Visible = True
        Worksheets("C").Visible = False
        Worksheets("D").Visible = False
        Worksheets("E").Visible = False


End Select

End Sub

CodePudding user response:

I would create two sub-routines for hiding rows and hiding sheets. Both take the value from your target-range (1, 2 or 3) and act accordingly.

Advantage: when you read the code in worksheet_change event you immediately understand on a high level what is happening without reading detailed code.

Within the sub-routines I removed the "select case" to avoid duplicate code. And in case there are more rows or sheets to be handled you only have to adjust that in one place.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Application.Intersect(Range("$B$8:$C$8"), Range(Target.Address)) Is Nothing Then
    hideShowSpecialRows Target.value
    hideShowSpecialSheets Target.value
End If
    
End Sub

'These routines could also go into a normal module
Public Sub hideShowSpecialRows(value As Long)

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("XXXXX")   'adjust to your needs
    
    ws.Rows(12).Hidden = CBool(value = 1 Or value = 3)
    
    Dim arrRows(2) As String, i As Long
    arrRows(0) = "35:42"
    arrRows(1) = "50"
    arrRows(2) = "55:57"
    
    For i = 0 To UBound(arrRows)
        ws.Rows(arrRows(i)).Hidden = CBool(value = 2 Or value = 3)
    Next

End Sub

Public Sub hideShowSpecialSheets(value As Long)
    
    With ThisWorkbook
        .Worksheets("A").Visible = CBool(value = 3)
        .Worksheets("B").Visible = CBool(value = 1 Or value = 3)
        .Worksheets("C").Visible = CBool(value = 2)
        .Worksheets("D").Visible = CBool(value = 2)
        .Worksheets("E").Visible = CBool(value = 1)
    End With
End Sub

CodePudding user response:

Worksheet Change for Hiding Rows and Workhseets

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Const sCellAddress As String = "B8"
    Dim sCell As Range: Set sCell = Intersect(Range(sCellAddress), Target)
    If Not sCell Is Nothing Then
        ShowHide sCell
    End If
End Sub

Sub ShowHide( _
        ByVal SourceCell As Range)
    Application.ScreenUpdating = False
    ShowHideRanges SourceCell
    ShowHideWorksheets SourceCell
    Application.ScreenUpdating = True
End Sub

Sub ShowHideRanges( _
        ByVal SourceCell As Range)
    Dim ws As Worksheet: Set ws = SourceCell.Worksheet
    Dim sValue As Long: sValue = CLng(SourceCell.Value)
    ws.Range("35:42,50:50,55:57").EntireRow.Hidden = CBool(sValue - 1) ' F,T,T
    ws.Range("12:12").EntireRow.Hidden = CBool(sValue Mod 2) ' T,F,T
End Sub

Sub ShowHideWorksheets( _
        ByVal SourceCell As Range)
    Const dNamesList As String = "A,B,C,D,E"
    Dim dNames() As String: dNames = Split(dNamesList, ",")
    Dim sValue As Long: sValue = CLng(SourceCell.Value)
    Dim wb As Workbook: Set wb = SourceCell.Worksheet.Parent
    wb.Worksheets(dNames(0)).Visible = CBool(sValue = 3) ' F,F,T
    wb.Worksheets(dNames(1)).Visible = CBool(sValue <> 2) ' T,F,T
    wb.Worksheets(dNames(2)).Visible = CBool(sValue = 2) ' F,T,F
    wb.Worksheets(dNames(3)).Visible = CBool(sValue = 2) ' F,T,F
    wb.Worksheets(dNames(4)).Visible = CBool(sValue = 1) ' T,F,F
End Sub
  • Related