VBA to test Outline levels

AllisterB

Board Regular
Joined
Feb 22, 2019
Messages
107
Office Version
  1. 365
Platform
  1. Windows
I am wanting to give the user the choice to expand the Outline Levels or not. I first want to check that the levels are not fully expanded already. However my code below errors on the first IF. Can someone help me with this?

Thank You

VBA Code:
Private Sub Worksheet_Activate()

'Anchors Freeze Frame
    ActiveWindow.FreezePanes = False

    Range("r_Anchor").Select
    
    ActiveWindow.FreezePanes = True
    'Protection to allow other macros to run on the sheet and to allow Filter and Grouping
 
    Me.Protect DrawingObjects:=True, Contents:=True, UserInterfaceOnly:=True, AllowFiltering:=True, AllowFormattingRows:=True, _
    AllowInsertingRows:=True, AllowFormattingCells:=True
Me.EnableOutlining = True

If Me.Outline.ShowLevels RowLevels:=4 and Me.Outline.ShowLevels ColumnLevels:=4 Then Exit Sub
If MsgBox("Do you want to Expand the  Rows and Columns", vbYesNo) = vbNo Then Exit Sub

'Expand Data Group Rows
  Me.Outline.ShowLevels RowLevels:=4, ColumnLevels:=2


End Sub
 

Some videos you may like

Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.

onlyadrafter

Well-known Member
Joined
Aug 19, 2003
Messages
5,703
Platform
  1. Windows
Hello,

think i may have found a workround, change the IF code line to

VBA Code:
If Columns("A:A").SpecialCells(xlCellTypeVisible).Count = Columns("A:A").Cells.Count Then Exit Sub

any use?
 

AllisterB

Board Regular
Joined
Feb 22, 2019
Messages
107
Office Version
  1. 365
Platform
  1. Windows
Thanks for this

I tried but got a 1004 error.
VBA Code:
Private Sub Worksheet_Activate()

'Anchors Freeze Frame
    ActiveWindow.FreezePanes = False

    Range("r_Anchor").Select
    
    ActiveWindow.FreezePanes = True
    'Protection to allow other macros to run on the sheet and to allow Filter and Grouping
 
    Me.Protect DrawingObjects:=True, Contents:=True, UserInterfaceOnly:=True, AllowFiltering:=True, AllowFormattingRows:=True, _
    AllowInsertingRows:=True, AllowFormattingCells:=True
Me.EnableOutlining = True



If Columns("A:A").SpecialCells(xlCellTypeVisible).Count = Columns("A:A").Cells.Count Then Exit Sub
If MsgBox("Do you want to Expand the  Rows and Columns", vbYesNo) = vbNo Then Exit Sub

'Expand Data Group Rows
  Me.Outline.ShowLevels RowLevels:=4, ColumnLevels:=2


End Sub
 

onlyadrafter

Well-known Member
Joined
Aug 19, 2003
Messages
5,703
Platform
  1. Windows
Hello,

at what line are you getting the error?

The code works for em, with two group of rows and one group of columns
 

Watch MrExcel Video

Forum statistics

Threads
1,113,928
Messages
5,545,076
Members
410,652
Latest member
Zot
Top