Excel shortcut to expand / collapse entire group outline level

Question

I'm trying to find out if there's a shortcut key combination in Excel to expand & collapse an entire group outline level. This would be the the equivalent of mouse clicking on the 1, 2, 3, ... buttons in the top left of the window:

I know you can expand collapse individual sections using ALT + a + j / ALT + a + h, but I have some spreadsheets with many grouped sections and often find myself wanting to collapse all of them to a given level. Ideally that wouldn't involve me reaching over to my mouse...

I've Googled this extensively but it's either not out there or beyond my Googling skills

Answer 1

The only way I can think of, is using Ctrl + A, followed by

ALT + A + J / ALT + A + H

You could also record these actions as a macro and assign a keyboard short cut to the macro

Answer 2

Inspired by Peter's comment, I went full-blown and wrote a macro that will expand to an arbitrary number input level, which was harder than I thought going in!

Then somewhere in my add-in start-up, I've got the line Application.OnKey Key:="^+r", Procedure:="OutlineRowLevels". This now means I can press the "shortcut" keys: CTRL + SHIFT + R, followed by a number [1 - 9] to expand / collapse to the desired level.

I've done a similar one for columns too but didn't see the point of spamming the post with almost identical code.

#If Win64 Then
    Private Declare PtrSafe Function GetAsyncKeyState Lib "user32" _
        (ByVal vKey As Long) As Integer
#Else
    Private Declare Function GetAsyncKeyState Lib "user32" _
        (ByVal vKey As Long) As Integer
#End If

Private Const VK_1 = &H31 '1 key
Private Const VK_2 = &H32 '2 key
Private Const VK_3 = &H33 '3 key
Private Const VK_4 = &H34 '4 key
Private Const VK_5 = &H35 '5 key
Private Const VK_6 = &H36 '6 key
Private Const VK_7 = &H37 '7 key
Private Const VK_8 = &H38 '8 key
Private Const VK_9 = &H39 '9 key
Private Const VK_ESCAPE = &H1B 'ESC key

Public Sub OutlineRowLevels()

Dim dTime As Date

    ' Record time 3 seconds from now
    dTime = DateAdd("s", 3, Time)

    ' Disable number keys or Excel will start editing
    Application.OnKey "1", ""
    Application.OnKey "2", ""
    Application.OnKey "3", ""
    Application.OnKey "4", ""
    Application.OnKey "5", ""
    Application.OnKey "6", ""
    Application.OnKey "7", ""
    Application.OnKey "8", ""
    Application.OnKey "9", ""

    ' Exit when ESC key is pressed
    ' or more than 3 seconds elapsed
    Do Until GetAsyncKeyState(VK_ESCAPE) Or (Time > dTime)

        DoEvents

        If GetAsyncKeyState(VK_1) Then
            ActiveSheet.Outline.ShowLevels RowLevels:=1
            Exit Do
        ElseIf GetAsyncKeyState(VK_2) Then
            ActiveSheet.Outline.ShowLevels RowLevels:=2
            Exit Do
        ElseIf GetAsyncKeyState(VK_3) Then
            ActiveSheet.Outline.ShowLevels RowLevels:=3
            Exit Do
        ElseIf GetAsyncKeyState(VK_4) Then
            ActiveSheet.Outline.ShowLevels RowLevels:=4
            Exit Do
        ElseIf GetAsyncKeyState(VK_5) Then
            ActiveSheet.Outline.ShowLevels RowLevels:=5
            Exit Do
        ElseIf GetAsyncKeyState(VK_6) Then
            ActiveSheet.Outline.ShowLevels RowLevels:=6
            Exit Do
        ElseIf GetAsyncKeyState(VK_7) Then
            ActiveSheet.Outline.ShowLevels RowLevels:=7
            Exit Do
        ElseIf GetAsyncKeyState(VK_8) Then
            ActiveSheet.Outline.ShowLevels RowLevels:=8
            Exit Do
        ElseIf GetAsyncKeyState(VK_9) Then
            ActiveSheet.Outline.ShowLevels RowLevels:=9
            Exit Do
        End If

    Loop

    ' Re-enable number keys
    ' ... or Excel will be crippled ;)
    Application.OnKey "1"
    Application.OnKey "2"
    Application.OnKey "3"
    Application.OnKey "4"
    Application.OnKey "5"
    Application.OnKey "6"
    Application.OnKey "7"
    Application.OnKey "8"
    Application.OnKey "9"

End Sub