How to create an outline from a database

I've been asked to create a list of elements from a database with the following requirements: the elements have to be arranged hierarchically and there have to be a possibility to collapse/expand them by levels. The structure of the database is set by levels, ie. 1st column = the highest level, 2nd column = the lower level, ..., the last column = the lowest level. I decided to use a pivot table because it sorts data quickly and precisely according to the requirements.

Step 1 - Create a Pivot table

• Select all data in your database and create a pivot table placed into a new worksheet (how to create a pivot table you can read for example here).
• Go to the PivotTable Options>Totals & Filters and uncheck Show grand totals for columns.
• Add all fields to Row Labels in order from top to bottom.

After a few clicks you have got the data sorted exactly as you want.

Step 2 - Copy the Pivot table

Now you need something that can help you to create the outline. A pivot table, again? Yes, because it can be set to an outline view. But you don't have to create a new one, just copy the created one in the column A.

• Copy the entire column A and paste it into the next column B.
• Place the cursor anywhere into the copied pivot table, go to Design>Report Layout and pick Show in Outline Form.

Step 3 - Delete the pivot tables and change text values to numbers

The pivot tables already did their job. From now you need only data of them.

• Select all cells of both pivot tables, copy their values and paste them into the first empty column in the active sheet.
• Delete the entire columns where the pivot tables are placed. Then delete all header rows.
• Select the cell B1 and press CTRL+SHIFT+END.
• Press CTRL+G to display the Go To dialog and click on the Special... button.
• Select Constants and click on the OK button.
• Write "1" and press CTRL+ENTER.

Step 4 - Create "Blank areas"

The columns from B represent the outline levels, their empty cells indicate rows that you want to assign to each level. Therefore is necessary exclude rows of the higher levels. You achieve this by adding "1" from the higher levels.

• Select used cells in column B (from B1 to the last used row in the active sheet) and press CTRL+C.
• Select the cell C1 and open the Paste Special dialog. In the Paste section select Values, in the Operation section select Add and click OK.

Values from the column B were added to the column C and used cells in this column were selected. Now repeat this for the rest of columns in the active sheet (add C to D, D to E and so on).

Step 5 - Create outline

Unfortunately to group more unconnected areas at once is not possible so you must help you out with a short VBA code. You can write a short subroutine or use immediate window for operations like that.

• Copy this code:

Select all

For Each a In Selection.Areas:a.Rows.Group:Next a

• Open VB editor (ALT+F11), activate the Immediate window and paste the code.
• Return to the sheet, go to Data>Outline, click on the arrow at the bottom right to open the outline settings dialog. Uncheck Summary rows below detail.
• Select used cells in column B (from B1 to the last used row in the active sheet)
• Press CTRL+G to display the Go To dialog and click on the Special... button.
• Select Blanks and click on the OK button.
• Go to the VB editor, place cursor to the copied code and press ENTER.

The first level of the outline has been created. Now do the same for all next columns except the last one. Then delete all columns from B and - that's it.

---

You can see the video:

---

I've always done it manually. I've had got a little bit of free time recently so I've made a decision to write the subroutine. It works with a selection so you have to select your database before you run it. Or, of course, you can adapt this code to conditions of yours.

Select all

Sub subCreateOutline()
  Dim bScreenUpdating As Boolean
  bScreenUpdating = Application.ScreenUpdating
  Application.ScreenUpdating = False
  
  Dim rDatabase As Range
  Set rDatabase = Selection

  With ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rDatabase).CreatePivotTable(TableDestination:=ActiveWorkbook.Worksheets.Add.Cells(1))
  .ColumnGrand = False
  .RowGrand = False
  
  Dim r As Range
  For Each r In rDatabase.Rows(1).Cells
    .PivotFields(CStr(r.Value)).Orientation = xlRowField
  Next r
  Set r = Nothing
  
  End With 'ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:=rDatabase).CreatePivotTable(TableDestination:=ActiveWorkbook.Worksheets.Add.Cells(1))

  With ActiveSheet
  .Outline.SummaryRow = xlAbove
        
  .Columns(1).Copy Destination:=Columns(2)
  On Error Resume Next
  .PivotTables(2).RowAxisLayout xlOutlineRow
  If Not Err.Number = 0 Then
    .PivotTables(1).RowAxisLayout xlOutlineRow
  End If
  On Error GoTo 0
  
  Set r = .UsedRange
  r.Copy
  r.Offset(0, r.Columns.Count).PasteSpecial (xlPasteValues)
  r.EntireColumn.Delete
  
  Dim rArea As Range
  With .UsedRange
  .Offset(1, 1).SpecialCells(xlCellTypeConstants).Value = 1
  For Each r In .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 2).Columns
    For Each rArea In r.SpecialCells(xlCellTypeBlanks)
      rArea.Rows.Group
    Next rArea
    
    r.Copy
    r.Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd
  Next r
  Set rArea = Nothing
  Set r = Nothing
  End With '.UsedRange
  
  .Range(.Columns(2), .Columns(.Columns.Count)).Delete
  .Rows(1).Delete
  .Cells(1).Select
  End With 'ActiveSheet
  
  Set rDatabase = Nothing
  
  Application.ScreenUpdating = bScreenUpdating
End Sub

Tweet