When a column of period-delimited numerical hierarchy identifiers is selected, this macro automatically groups them together. Sourced from https://web.archive.org/web/20170424081712/http://www.relken.com/code-example/vba-code-set-row-outline-level-structured-numbers which I dug up because this SuperUser answer ( https://superuser.com/a/1252011 )…

ExcelOutlinerGroupingMacro.vb

Sub SetLevel()
' SETLEVEL sets the outline level for each selected row based on the depth of a structured number.
'   When there is no structured number, the level is set to one higher than the previous number.
'   Sets the level 0 to the first cell highlighted by the user. For example if 1.2.3 is the first
'   cell, then 1.2.3.1 is level 1 and 1.2.3.1.1. is level 2 and so forth.
'   If the first cell is not a number, then it is set to level 0, and all numbers start at 1.
 
'SYNTAX
'   The user selects the range of structured numbers within the sheet, then runs this macro.
 
'EXAMPLE
'   Let the first cell be "1." this outline level is set to 1
'   Let the next cell be "1.1." this outline level is set to 2, etc.
'   OR
'   Let the first cell be "N/A" this outline level is set to 1
'   Let the next cell be "1." this outline level is set to 2,
'   Let the next cell be "1.1." this outline level is set to 3, etc.
'
'  Author:    Andrew O'Connor <andrew.oconnor@relken.com>
'  Date:      23 Apr 2013
'  Copyright: 2014 Relken Engineering
 
    Dim WBSRange As Range           'Range of selected cells
    Dim c As Variant                'Cell used in loop
    Dim cdepth As Long              'Depth of previous WBS (based on outline level
    Dim cValue As String            'Previous WBS Value
    Dim i As Long                   'Loop counter
    Dim endwithstop As Boolean      'True if the WBS item ends in a fullstop
    Dim startDepth As Long          'The depth of the first row
 
    'If Cells references not provided then use the selection
    'If WBSRange Is Nothing Then
    Set WBSRange = Application.Selection
    'End If
 
    'Get the depth of the first row
    'Find the depth of the WBS
    cValue = WBSRange.Cells(1, 1).Value
    i = -1
    dotpos = 1
    Do While dotpos > 0
        i = i + 1
        dotpos = InStr(cValue, ".")
        If dotpos - 1 > 0 Then
            cValue = Mid(cValue, dotpos + 1)
        End If
    Loop
    startDepth = i
 
    'Loop through each row if the selection
    For Each c In WBSRange
        'Get the WBS Value
        cValue = CStr(c.Value)
        If cValue = "" Then
            Set pCell = c.End(xlUp)
            cValue = pCell.Value
            cdepth = 1
        Else
            cdepth = 0
        End If
 
        'Determine if trailing fullstops are being used
        endwithstop = Right(cValue, 1) = "."
        If Not endwithstop Then
            cValue = cValue & "."
        End If
 
        'Find the depth of the WBS
        i = -1
        dotpos = 1
        Do While dotpos > 0
            i = i + 1
            dotpos = InStr(cValue, ".")
            If dotpos - 1 > 0 Then
                cValue = Mid(cValue, dotpos + 1)
            End If
        Loop
        cdepth = cdepth + i
 
        'Set Depth if not zero
        If cdepth - startDepth > 0 Then
            'Set the depth
            c.Rows.OutlineLevel = cdepth - startDepth
        End If
 
    Next c
 
End Sub