View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
Jim Cone Jim Cone is offline
external usenet poster
 
Posts: 3,290
Default Determine the number of outline levels using vba

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(xlCellTypeVisib le)
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