Determine the number of outline levels using vba

[Jamie Richards]

Hi Folks,

Does anyone know if it possible to count the number of levels in an Excel
worksheet outline using code? For example in the same way you may count rows
using "ActiveSheet.UsedRange.Rows.Count".

I want to use this feature to assist with showing and hiding grouped rows in
a protected worksheet.

TIA!

Jamie

 

[Jim Cone]

Jamie,
There is probably a better way.
Please test this thoroughly before distributing the code to the entire company. <g>
--
Jim Cone
San Francisco, USA
http://www.realezsites.com/bus/primitivesoftware

Sub HowManyLevels()
'Determines the number of outline levels (8 or less)
'Jim Cone - San Francisco, USA - October 2006
Dim lngNewCount As Long
Dim lngOldCount As Long
Dim N As Long
Dim rngArea As Excel.Range
Dim rngVisible As Excel.Range

N = 8 'Throws error on xl2002 if > 8.
lngOldCount = ActiveSheet.UsedRange.Rows.Count

Do
ActiveSheet.Outline.ShowLevels rowlevels:=N
Set rngVisible = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
For Each rngArea In rngVisible.Areas
lngNewCount = lngNewCount + rngArea.Rows.Count
Next

'The first instance where rows are hidden.
If lngNewCount <> lngOldCount Then
MsgBox N + 1 & " Levels"
Exit Do
Else
'Reset counters
lngOldCount = lngNewCount
lngNewCount = 0
End If
'Set to the next level
N = N - 1
Loop

Set rngArea = Nothing
Set rngVisible = Nothing
End Sub
'-------------


"Jamie Richards"
<[email protected]>
wrote in message
Hi Folks,
Does anyone know if it possible to count the number of levels in an Excel
worksheet outline using code? For example in the same way you may count rows
using "ActiveSheet.UsedRange.Rows.Count".
I want to use this feature to assist with showing and hiding grouped rows in
a protected worksheet.
TIA!
Jamie

 

[Jim Cone]

And this version also works on a sheet with no outline.
--
Jim Cone
San Francisco, USA
http://www.officeletter.com/blink/specialsort.html


Sub HowManyLevels_R1()
'Determines the number of outline levels (8 or less)
'Jim Cone - San Francisco, USA - October 2006
Dim lngNewCount As Long
Dim lngOldCount As Long
Dim N As Long
Dim rngArea As Excel.Range
Dim rngVisible As Excel.Range

N = 8 ' Throws error on xl2002 if > 8.
lngOldCount = ActiveSheet.UsedRange.Rows.Count

Do
ActiveSheet.Outline.ShowLevels rowlevels:=N
Set rngVisible = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
For Each rngArea In rngVisible.Areas
lngNewCount = lngNewCount + rngArea.Rows.Count
Next
'The first instance where rows are hidden.
If lngNewCount <> lngOldCount Then
MsgBox N + 1 & " Outline levels on sheet. "
Exit Do
Else
'Reset counters
lngOldCount = lngNewCount
lngNewCount = 0
End If
'Set to the next level
N = N - 1
Loop Until N < 0
If N < 0 Then MsgBox "No outline levels on sheet. "

Set rngArea = Nothing
Set rngVisible = Nothing
End Sub