rahildhody
New Member
- Joined
- Aug 4, 2016
- Messages
- 41
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!
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!
Code:
'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
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
