Automate hide-unhide button based on heading style

[rahildhody]

I want to be able to hide/unhide rows (or group them, whichever works better) based on heading styles & heading order. I've tried using an .Autofilter technique but very quickly realised its dangers if people dont use subtotals as sums & major information was missed because of that method in the past.

Headings are always in Column AV, FirstCell is always BA36. the space between headers can be dynamic depending on content section

I want it to work as follows:
Everything visible & hide pressed: hide everything below lowest header found & keep all section headers, when pressed again, hide the bottom most heading & work its way up. & opposite for show button.

Ive tried to modify a code that existed previously for only 2 Header sections, to include a 3 Heading section but its a little buggy in the scenario where Header 1 & Header 2 are shown & hide is pressed. I want it to show only Header 1, but it unhides everything.

I have a few headers in my worksheet but i need to make sure i select headers 1, 2 or 3 only & live with not being able to see the other headers & have it bug out in one section. it would be nice to have this replicated across n number of headers used in the sheet, by picking on the style name defined at the start of this code.

Any help on this matter would be greatly appreciated.

Sub ShowHide_partial()
Dim FirstCell As Range

Const Header1Style As String = "Hdr1"
Const Header2Style As String = "Hdr2"
Const Header3Style As String = "Hdr3"
Const FakeStyle As String = "This is a fake style"

On Error GoTo TheEnd

    Application.StatusBar = "Hiding/showing rows: please wait..."



    Set FirstCell = Range("BA35")
    Do While FirstCell.Style <> Header1Style
        Set FirstCell = FirstCell.Offset(1, 0)
        If FirstCell.Row > Cells.SpecialCells(xlCellTypeLastCell).Row Then
            GoTo TheEnd
        End If
    Loop

    If Application.Caller = "ShowButton" Then 'show button pressed
        Application.StatusBar = "Unhiding rows: please wait..."
        
        Select Case SectionStatus(FirstCell, Cells.SpecialCells(xlCellTypeLastCell).Offset(-1, 0), Header1Style, Header2Style, Header3Style)
            Case 1 'a
                Call CycleSection(FirstCell, Cells.SpecialCells(xlCellTypeLastCell), 3, Header1Style, Header2Style, Header3Style)
                
            Case 2 'a
                Call CycleSection(FirstCell, Cells.SpecialCells(xlCellTypeLastCell), 4, Header1Style, Header2Style, Header3Style)
                
            Case 3 'a
                Call CycleSection(FirstCell, Cells.SpecialCells(xlCellTypeLastCell), 5, Header1Style, Header2Style, Header3Style)
            
            Case 4 'a
                Call CycleSection(FirstCell, Cells.SpecialCells(xlCellTypeLastCell), 5, Header1Style, Header2Style, Header3Style)
            
            Case 5 'a
                Call CycleSection(FirstCell, Cells.SpecialCells(xlCellTypeLastCell), 5, Header1Style, Header2Style, Header3Style)
            
            Case Else 'any other status, go to showing everything
                Call CycleSection(FirstCell, Cells.SpecialCells(xlCellTypeLastCell), 5, Header1Style, Header2Style, Header3Style)
          
        End Select
            
    ElseIf Application.Caller = "HideButton" Then 'hide button pressed
        Application.StatusBar = "Hiding rows: please wait..."
        
        Select Case SectionStatus(FirstCell, Cells.SpecialCells(xlCellTypeLastCell).Offset(-1, 0), Header1Style, Header2Style, Header3Style)
        
            Case 1 '
                Call CycleSection(FirstCell, Cells.SpecialCells(xlCellTypeLastCell), 5, Header1Style, Header2Style, Header3Style)
            Case 2 '
                Call CycleSection(FirstCell, Cells.SpecialCells(xlCellTypeLastCell), 2, Header1Style, Header2Style, Header3Style)
            Case 3 '
                Call CycleSection(FirstCell, Cells.SpecialCells(xlCellTypeLastCell), 3, Header1Style, Header2Style, Header3Style)
            Case 4 '
                Call CycleSection(FirstCell, Cells.SpecialCells(xlCellTypeLastCell), 4, Header1Style, Header2Style, Header3Style)
            Case 5 '
                Call CycleSection(FirstCell, Cells.SpecialCells(xlCellTypeLastCell), 5, Header1Style, Header2Style, Header3Style)
            Case Else 'any other status, go to showing only first headers (by using a fake colour for second headers)
                Call CycleSection(FirstCell, Cells.SpecialCells(xlCellTypeLastCell), 5, Header1Style, Header2Style, FakeStyle)
        
        End Select

    Else
        'procedure called not using buttons
        MsgBox "Invalid caller"
    End If

TheEnd:
    Application.StatusBar = False
    

End Sub


Sub CycleSection(FirstCell As Range, LastCell As Range, NewStatus As Integer, Header1Style As String, Header2Style As String, Header3Style As String)
'cycles hidden/visible status of section
'NewStatus=1 hides everything
'NewStatus=2 hides everything except header 1
'NewStatus=3 hides everything except header 1 & header 2
'NewStatus=4 hides everything except header 1, header 2 & header 3
'NewStatus=5 unhides everything
Dim VisibleRange As Range
Dim TheRow As Long
Dim LowerHeadersFound As Boolean
Const HdrCol = 4 'column D

    Select Case NewStatus
    
        'hide everything
        Case 1
            Range(FirstCell.Offset(1, 0), LastCell).EntireRow.Hidden = True
            FirstCell.EntireRow.Hidden = False
            
        'unhide all lower section headers below header 1
        Case 2
            LowerHeadersFound = False
            Set VisibleRange = FirstCell.EntireRow
            
            'find section headers
            For TheRow = FirstCell.Offset(1, 0).Row To LastCell.Row
                If Cells(TheRow, HdrCol).Style = Header1Style Then
                    LowerHeadersFound = True
                    Set VisibleRange = Union(VisibleRange, Cells(TheRow, HdrCol).EntireRow)
                End If
            Next TheRow
            If LowerHeadersFound = False Then 'no subheaders
                Range(FirstCell, LastCell).EntireRow.Hidden = False
            Else 'subheaders exist
                Range(FirstCell.Offset(1, 0), LastCell).EntireRow.Hidden = True
                VisibleRange.EntireRow.Hidden = False
            End If
            
        'unhide all lower section headers below header 1 & header 2
        Case 3
            LowerHeadersFound = False
            Set VisibleRange = FirstCell.EntireRow
            
            'find section headers
            For TheRow = FirstCell.Offset(1, 0).Row To LastCell.Row
                If Cells(TheRow, HdrCol).Style = Header1Style Or Cells(TheRow, HdrCol).Style = Header2Style Then
                    LowerHeadersFound = True
                    Set VisibleRange = Union(VisibleRange, Cells(TheRow, HdrCol).EntireRow)
                End If
            Next TheRow
            If LowerHeadersFound = False Then 'no subheaders
                Range(FirstCell, LastCell).EntireRow.Hidden = False
            Else 'subheaders exist
                Range(FirstCell.Offset(1, 0), LastCell).EntireRow.Hidden = True
                VisibleRange.EntireRow.Hidden = False
            End If
            
        'unhide all lower section headers below header 1, header 2, header 3
        Case 4
            LowerHeadersFound = False
            Set VisibleRange = FirstCell.EntireRow
            'find section headers
            For TheRow = FirstCell.Offset(1, 0).Row To LastCell.Row
                If Cells(TheRow, HdrCol).Style = Header1Style Or Cells(TheRow, HdrCol).Style = Header2Style Or Cells(TheRow, HdrCol).Style = Header3Style Then
                    LowerHeadersFound = True
                    Set VisibleRange = Union(VisibleRange, Cells(TheRow, HdrCol).EntireRow)
                End If
            Next TheRow
            If LowerHeadersFound = False Then 'no subheaders
                Range(FirstCell, LastCell).EntireRow.Hidden = False
            Else 'subheaders exist
                Range(FirstCell.Offset(1, 0), LastCell).EntireRow.Hidden = True
                VisibleRange.EntireRow.Hidden = False
            End If
            
        'unhide everything
        Case 5
            Range(FirstCell, LastCell).EntireRow.Hidden = False
            
        'do nothing
        Case Else
            'do nothing if something else has been passed
    End Select
    Debug.Print NewStatus
    'Stop

End Sub


Function SectionStatus(FirstCell As Range, LastCell As Range, Header1Style As String, Header2Style As String, Header3Style As String) As Integer
'sectionstatus=0 if not a section header
'sectionstatus=1 only header 1 is showing
'sectionstatus=2 header 1 and header 2 are showing
'sectionstatus=3 header 1, header 2 and header 3 are showing
'sectionstatus=4 if everything is visible
'sectionstatus=5 if anything else...

    
Dim SectionComplete As Boolean
Dim UpperLevelHiddenFound As Boolean
Dim UpperLevelVisibleFound As Boolean
Dim MidLevelHiddenFound As Boolean
Dim MidLevelVisibleFound As Boolean
Dim LowerLevelHiddenFound As Boolean
Dim LowerLevelVisibleFound As Boolean
Dim NoHeaderHiddenFound As Boolean
Dim NoHeaderVisibleFound As Boolean
Dim Counter As Long
Dim FirstCellStyle As String
Dim TheCell As Range 'index cell

    'set up variables
    FirstCellStyle = FirstCell.Style
    SectionComplete = False
    LowerLevelHiddenFound = False
    LowerLevelVisibleFound = False
    MidLevelHiddenFound = False
    MidLevelVisibleFound = False
    NoHeaderHiddenFound = False
    NoHeaderVisibleFound = False

    If FirstCellStyle <> Header1Style And FirstCellStyle <> Header2Style And FirstCellStyle <> Header3Style Then
        'initial cell is not a header
        SectionStatus = 0
    ElseIf FirstCell.Row = LastCell.Row Then
        'no section
        SectionStatus = 0
    Else
        'runs down rows to ascertain what is in the section
        Counter = 1
        Do While SectionComplete = False
            Set TheCell = FirstCell.Offset(Counter)
            If TheCell.Row > LastCell.Row Then
                SectionComplete = True
            ElseIf TheCell.Style = Header1Style Then
                If TheCell.EntireRow.Hidden = True Then
                    UpperLevelHiddenFound = True
                ElseIf TheCell.EntireRow.Hidden = False Then
                    UpperLevelVisibleFound = True
                End If
            ElseIf TheCell.Style = Header2Style Then
                If TheCell.EntireRow.Hidden = True Then
                    MidLevelHiddenFound = True
                ElseIf TheCell.EntireRow.Hidden = False Then
                    MidLevelVisibleFound = True
                End If
            ElseIf TheCell.Style = Header3Style Then
                If TheCell.EntireRow.Hidden = True Then
                    LowerLevelHiddenFound = True
                ElseIf TheCell.EntireRow.Hidden = False Then
                    LowerLevelVisibleFound = True
                End If
            Else
                If TheCell.EntireRow.Hidden = True Then
                    NoHeaderHiddenFound = True
                ElseIf TheCell.EntireRow.Hidden = False Then
                    NoHeaderVisibleFound = True
                End If
            End If
            Counter = Counter + 1
        Loop
        
'    Debug.Print UpperLevelHiddenFound
'    Debug.Print UpperLevelVisibleFound
'    Debug.Print MidLevelHiddenFound
'    Debug.Print MidLevelVisibleFound
'    Debug.Print LowerLevelHiddenFound
'    Debug.Print LowerLevelVisibleFound
'    Debug.Print NoHeaderHiddenFound
'    Debug.Print NoHeaderVisibleFound
    
         'determines status by what has been found in the section
        If NoHeaderVisibleFound = False And LowerLevelVisibleFound = False And MidLevelVisibleFound = False Then
            SectionStatus = 1
        ElseIf NoHeaderVisibleFound = False And LowerLevelVisibleFound = False Then
            SectionStatus = 2
        ElseIf NoHeaderVisibleFound = False And LowerLevelHiddenFound = False Then
            SectionStatus = 3
        ElseIf NoHeaderHiddenFound = False And LowerLevelHiddenFound = False Then
            SectionStatus = 4
        Else
            SectionStatus = 5
        End If
    End If
    
    Debug.Print SectionStatus

End Function