How to programmatically determine which rows are outlined using Excel VBA code

[David]

Is there a way to programmatically determine (i.e., using
VBA code) which rows and/or columns are outlined on an
Excel spreadsheet?

I have spreadsheets with three different groups of columns
outlined (one level of outline demotion each - no
overlap). The specific columns that are outlined change
based on the data. I would like to write VBA code to 1)
programmatically determine the groups of outlined columns,
and then, 2) reduce the number of outlined columns in one
of the groups (the third one).

Example using R1C1 reference notation: Outlined
columns: 1, 5-12, and 19-40

My goal is to reduce the third outline group by the first
three columns of the group. In this case group 19-40
would have columns 19-21 promoted by using code like
Range(Cells(1, 19), Cells(1, 21)).Select
Selection.Columns.Ungroup

It is easy to promote the columns manually, but it is a
pain to do over and over again at the end of an otherwise
automated process (VBA code) that is formatting the
spreadsheet.

For the curious - why do I want to promote three columns
programmatically? VBA code is used to extensively format
an Excel file including adding lookup table data as new
worksheets, adding formulas that use the VLOOKUP function,
a macro button and code "behind" the button to provide
sort options, borders, outlining to hide some cost history
columns and future projections columns so a window of data
around the current month data is displayed and the report
is constrained to one print page wide on 11" wide by 17"
high tabloid size paper at about 64% reduction, etc. The
data includes hours and dollars totals for labor,
material, travel, etc. A "values only" summary of the
totals rows is created as a separate (11" wide by 8-1/2"
high when printed) "Summary" sheet. Additional
calculations are added to the summary sheet
programmatically. Some columns at the right side of the
data are not needed on the summary sheet. These columns
are deleted. This leaves the summary sheet "viewable
print data" not as wide as the area available. Removing
three columns from the hidden outline of the future months
fills the page and shows more data.

The kind of outlining I am referring to has to do with how
to show or hide detail data (i.e., rows and/or columns) in
an outline. If you enter this phrase, "Show or hide
detail data in an outline", in the Help Answer Wizard you
will see how outlining is done manually.

I want to programmatically determine which columns
are "outlined" (i.e., can be shown by a click on a "+"
button in the margin of the spreadsheet outside the grid
area or hidden easily by a click on a "-" button in the
margin of the spreadsheet outside the grid area. I assume
there is a collection where this data is stored (something
like columns.outline or some such).

Thanks for any help.

 

[Robin Hammond]

David,

This is not doing everything for you, and there may well be a better way,
but here's a quick function that will return the range of the current
outline group assuming a cell has been outlined, or nothing if there is no
outline applied. You should be able to apply this to figure out what you
need to ungroup.

Option Explicit
Option Private Module

Sub Test()
Dim rngOutline As Range
'select a cell within your outlined section to get the range of the outline
returned
Set rngOutline = OutlineRange(Selection)
If Not rngOutline Is Nothing Then Debug.Print rngOutline.Address
End Sub

Public Function OutlineRange(rngTest As Range) As Range
Dim lOffset As Long
Dim lLevel As Long

'see if there is an outline at all
lLevel = rngTest(1, 1).EntireColumn.OutlineLevel
If lLevel = 1 Then Exit Function 'returns an empty range

Do While rngTest(1, 1).Column > 1

If rngTest(1, 1).Offset(0, -1).EntireColumn.OutlineLevel = lLevel Then
Set rngTest = Union(rngTest, rngTest.Offset(0, -1))
Else
Exit Do
End If
Loop

Do While rngTest(1, rngTest.Columns.Count).Column < 255

If rngTest(1, rngTest.Columns.Count).Offset(0,
1).EntireColumn.OutlineLevel = lLevel Then
Set rngTest = Union(rngTest, rngTest.Offset(0, 1))
Else
Exit Do
End If
Loop
Set OutlineRange = rngTest
End Function

HTH,

Robin Hammond
www.enhanceddatasystems.com