Macro to Hide/Unhide rows based on Header Styles

[rahildhody]

Hi,

I'm trying to edit a macro to hide/unhide rows based on header styles.

What I currently have is a Show and Hide button on every sheet in the workbook that performs the below routine. What the routine does is if every single row is visible and the hide button is pressed once, then it hides everything except Header 1 and Header 2, and if the hide button is pressed the 2nd time, then it hides everything except Header 1. Similarly, it does the same thing when Show button is pressed.

What I'm trying to achieve if have a Header 3 in there as well. So if every single row is visible and the Hide button is pressed once, then it hides everything except Header 1, Header 2 and Header 3, if the Hide Button is pressed the 2nd time, then hides everything except Header 1 and Header 2 and when pressed the 3rd time, hides everything except Header 1.

Could someone please help me amend this code, or if there is a better way to execute what I'm trying to achieve, then I'm all ears!

Thank you for your help!

'ShowHideMaster is attached to buttons to show/hide all rows bar headers
'CycleSectionHiddenMaster is attached to the double click function to cycle through visibility options for a section
'Each of these master macros makes use of the following subroutines and functions:
'CycleSection performs the hiding/unhiding for a number of "to be" states
'SectionEndCell is a function to find the end of a section (i.e. the next time the same or higher level header is reached)
'SectionStatus returns the visibility status of the section, from all hidden to all visible through only headers visible, etc

Sub BSShowHide()
Dim FirstCell As Range
Dim IsProtected As Boolean

Const Header1Style As String = "BS Header Main"
Const Header2Style As String = "BS Header Secondary"
Const FakeStyle As String = "This is a fake style"


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

    Set FirstCell = Range("B15")
    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..."
        If SectionStatus(FirstCell, Cells.SpecialCells(xlCellTypeLastCell).Offset(-1, 0), Header1Style, Header2Style) = 1 Then
            'all hidden except first headers, so go to showing all headers
            Call CycleSection(FirstCell, Cells.SpecialCells(xlCellTypeLastCell), 2, Header1Style, Header2Style)
        Else
            'any other status, go to showing everything
            Call CycleSection(FirstCell, Cells.SpecialCells(xlCellTypeLastCell), 3, Header1Style, Header2Style)
        End If
    ElseIf Application.Caller = "HideButton" Then 'hide button pressed
        Application.StatusBar = "Hiding rows: please wait..."
        If SectionStatus(FirstCell, Cells.SpecialCells(xlCellTypeLastCell).Offset(-1, 0), Header1Style, Header2Style) = 4 Then
            'everything showing, so go to showing all headers
            Call CycleSection(FirstCell, Cells.SpecialCells(xlCellTypeLastCell), 2, Header1Style, Header2Style)
        Else
            'any other status, go to showing only first headers (by using a fake colour for second headers)
            Call CycleSection(FirstCell, Cells.SpecialCells(xlCellTypeLastCell), 2, Header1Style, FakeStyle)
        End If
    Else
        'procedure called not using buttons
        MsgBox "Invalid caller"
    End If

TheEnd:
    Application.ScreenUpdating = True
    Application.StatusBar = False
    Exit Sub


End Sub


Function SectionStatus(FirstCell As Range, LastCell As Range, Header1Style As String, Header2Style As String) As Integer
'sectionstatus=0 if not a section header
'sectionstatus=1 if everything is hidden except top level headers
'sectionstatus=2 if only and all headers are showing
'sectionstatus=3 if anything else...
'sectionstatus=4 if everything is visible
    
Dim SectionComplete As Boolean
Dim UpperLevelHiddenFound As Boolean
Dim UpperLevelVisibleFound 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
    NoHeaderHiddenFound = False
    NoHeaderVisibleFound = False

    If FirstCellStyle <> Header1Style And FirstCellStyle <> Header2Style 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
                    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
    
        'determines status by what has been found in the section
        If NoHeaderVisibleFound = False And LowerLevelHiddenFound = False And UpperLevelHiddenFound = False Then
            SectionStatus = 2
        ElseIf NoHeaderVisibleFound = False And LowerLevelVisibleFound = False Then
            SectionStatus = 1
        ElseIf NoHeaderHiddenFound = False And LowerLevelHiddenFound = False And UpperLevelHiddenFound = False Then
            SectionStatus = 4
        Else
            SectionStatus = 3
        End If

    End If

End Function

Sub CycleSection(FirstCell As Range, LastCell As Range, NewStatus As Integer, Header1Style As String, Header2Style As String)
'cycles hidden/visible status of section
'NewStatus=1 hides everything
'NewStatus=2 hides everything except all section headers
'NewStatus=3 unhides everything
Dim VisibleRange As Range
Dim TheRow As Long
Dim LowerHeadersFound As Boolean

    Select Case NewStatus
        Case 1 'hide everything
            Range(FirstCell.Offset(1, 0), LastCell).EntireRow.Hidden = True
            FirstCell.EntireRow.Hidden = False
        Case 2 'unhide all lower section headers
            LowerHeadersFound = False
            Set VisibleRange = FirstCell.EntireRow
            'find section headers
            For TheRow = FirstCell.Offset(1, 0).Row To LastCell.Row
                If Cells(TheRow, 2).Style = Header2Style Or Cells(TheRow, 2).Style = Header1Style Then
                    LowerHeadersFound = True
                    Set VisibleRange = Union(VisibleRange, Cells(TheRow, 2).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
        Case 3
            Range(FirstCell, LastCell).EntireRow.Hidden = False
        Case Else
            'do nothing if something else has been passed
    End Select
    

End Sub



'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
'End of Show/Hidefunctionality
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<

 

[rahildhody]

Can someone please help with this?

 

[Yongle]

I looked at your code and thought

Does the code really need to be this complex?

Consider using Data Filter
- Add column Z (hidgen if preferred)
- In column Z enter a "flag" either 9 (default) or 1 or 2 or 3 (to specify header style)
- No filter for all rows visible
- Filter 1, 2 & 3 to for non-headers hidden
- Filter 1, 2 for Header3 hidden
- Filter 1 for only Header1 visible

Use VBA
- to generate the flag based on header styles
- behind your "Button" to filter the data

Will this approach work?
Let me know and I will help you develop the idea further.

 

[rahildhody]

Hi Yongle,
Thanks for your response. That could work and I did think of that approach. But the issue is that the code I'm generating is actually for my company's Budget Model and having a filter on each page isn't going to be a neat approach. With this code (that currently works for Header 1 and Header 2) I assign the same subroutine to both the buttons and then just copy and paste the buttons on each sheet of the budget model.

Is it difficult to include the same functionality for Header 3 in that code though?

Thanks again for your help.

 

[Yongle]

Make the column zero width and it is perfectly neat
- what difference how many sheets there are?

Why should header 3 cause a problem? what is your concern?

 

[rahildhody]

Why should header 3 cause a problem? what is your concern?

Hi Yongle,

Currently the code is condensing everything below header 2 first, then condensing all header 2s leaving only Header 1 visible each time the hide button is pressed.

I want the code to first condense everything below header 3, showing header 1 - header 2 - header 3 only, then condense all header 3s showing header 1 and header 2 and then condense header 2 leaving only Header 1 visible. I'm not sure how to amend that code to include the header 3 functionality as well. This code was developed by someone else and I amended it slightly to fit my purpose. I want to amend it further to include the header 3 stuff as well



Okay, can you help me develop the idea further then? How do I use vba to create the flags for header styles in a column?

 

[Yongle]

Test this on a copy of a typical sheet.

Unchanged ...
- last value found in the worksheet determines variable lastRow
- Rows 2 to lastRow given value Normal in column Z
- value in column Z is overwritten if style is not "Normal" in any cell in columns A,B,C or D
- filter dropdown added to column Z

To tailor for your worksheet ...
Amend the following to put the flag in the column you prefer and to help VBA search the minimum number of columns for styles
Flag = "Z" : amend Flag column letter (to keep things simple leave at least one blank column between your data and the "Flag" column)
Hdrs = "A,B,C,D" : List of columns that contain different headers - if columns D to P are identical (eg 12 months + Year) then only include ONE of them

The sheet must contain values to allow VBA to find the lastRow

Sub AddFlags()
    Const Flag = "[COLOR=#b22222]Z[/COLOR]"
    Const Hdrs = "[COLOR=#b22222]A,B,C,D[/COLOR]"
    Dim ws As Worksheet, lastRow As Long, cel As Range, rng As Range, HdrCols, HdrCol
    Set ws = ActiveSheet
    Set rng = ws.UsedRange
    HdrCols = Split(Hdrs, ",")
    lastRow = rng.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'add default flag in column
    ws.Cells(1, Flag).Resize(lastRow).Clear
    ws.Cells(1, Flag) = "STYLE"
    ws.Cells(2, Flag).Resize(lastRow - 1) = "Normal"
'overwrite flag if style is not "Normal"
    For Each HdrCol In HdrCols
        For Each cel In ws.Cells(1, HdrCol).Resize(lastRow)
            With ws.Cells(cel.Row, Flag)
                If .Value = "Normal" Then .Value = cel.Style
            End With
        Next cel
    Next HdrCol
'filter dropdown
    ws.AutoFilterMode = False
    ws.Cells(1, Flag).AutoFilter
End Sub

Test manually to see if filtering on values in Z gives you the control required
- then we can add a few more lines to automate the filtering the way you want

 

[rahildhody]

Okay this works perfectly in identifying what the row is. Thanks for that.

One adjustment I'd like to make in it though. I put freeze panes in cell K15 in every single sheet. Rows 1-14 are always the date ranges/financial yr info/period start/end etc. and columns A-J are for any names, units etc etc.

I amended the above code for it to below, but it keeps finding the last row as 13 rows below the actual last row. is it because I've shifted the rows down by 14?

Sub AddFlags()
    Const Flag = "Z"
    Const Hdrs = "A,B,C,D"
    Dim ws As Worksheet, lastRow As Long, cel As Range, rng As Range, HdrCols, HdrCol
    Set ws = ActiveSheet
    Set rng = ws.UsedRange
    HdrCols = Split(Hdrs, ",")
    lastRow = rng.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'add default flag in column
    ws.Cells(1, Flag).Resize(lastRow).Clear
    ws.Cells(14, Flag) = "STYLE"
    ws.Cells(15, Flag).Resize(lastRow - 1) = "Normal"
'overwrite flag if style is not "Normal"
    For Each HdrCol In HdrCols
        For Each cel In ws.Cells(15, HdrCol).Resize(lastRow)
            With ws.Cells(cel.Row, Flag)
                If .Value = "Normal" Then .Value = cel.Style
            End With
        Next cel
    Next HdrCol
'filter dropdown
    ws.AutoFilterMode = False
    ws.Cells(14, Flag).AutoFilter
End Sub

would amending

ws.Cells(15, Flag).Resize(lastRow - 1) = "Normal"

to

ws.Cells(15, Flag).Resize(lastRow - 14) = "Normal"

do the job?

Could you help me build the filtering functionality please. Thanks a lot for all your help!

 

[Yongle]

I amended the above code for it to below, but it keeps finding the last row as 13 rows below the actual last row. is it because I've shifted the rows down by 14?
Code:

yes - and your approach to correcting for it should work.
I would do it slightly differently (just to make the code easier to understand in a few months time) - will post that approach plus filtering functionality tomorrow

 

[rahildhody]

perfect. Thank you