Grouping and Ungrouping Macro for multiple sheets

[adhoraji09]

Hello,

I am trying to run this macro to group and ungroup columns on multiple sheets. It seems to only be working on one sheet at a time. For example it works on tab net sales but then I have to run it again for trade tab. I would i make this macro work for both net sales and trade tab with one macro or click.

Sub MacroGroup()
ActiveSheet.Outline.ShowLevels ColumnLevels:=2
Columns("K:P").Columns.UnGroup
Columns("L:R").Columns.Group
ActiveSheet.Outline.ShowLevels ColumnLevels:=1
End Sub

Thanks.

 

[jbeaucaire]

Something like this, maybe:

Sub MacroGroup()
Dim ws As Worksheet

For Each ws In Sheets(Array("Net Sales", "Trade"))
    ws.Outline.ShowLevels ColumnLevels:=2
    ws.Columns("K:P").Columns.Ungroup
    ws.Columns("L:R").Columns.Group
    ws.Outline.ShowLevels ColumnLevels:=1
Next ws

End Sub

 

[adhoraji09]

I seem to be getting an error. This is the macro I am running right now. It only works one sheet at a time. I would like to find away for it to do all sheets at once.

Sub grouping()
ActiveSheet.Outline.ShowLevels ColumnLevels:=2
Columns("K:O").Columns.UnGroup
Columns("L:O").Columns.Group
ActiveSheet.Outline.ShowLevels ColumnLevels:=1
' grouping Macro
'
' Keyboard Shortcut: Ctrl+y
'
End Sub

 

[jbeaucaire]

Sub MacroGroup()
Dim ws As Worksheet

On Error Resume Next
For Each ws In Sheets(Array("Net Sales", "Trade"))
    ws.Outline.ShowLevels ColumnLevels:=2
    ws.Columns("K:P").Columns.Ungroup
    ws.Columns("L:R").Columns.Group
    ws.Outline.ShowLevels ColumnLevels:=1
Next ws

End Sub

You may need to edit the Array of sheetnames in the macro to be

 

[YAZ2015]

Hello jbeaucaire/Everyone:

Please could you help me!

I am trying to modify your macroGroup Vb script for grouping and ungrouping base on the value in AF1. This value could be Y or N. But it is not working.

My excel worksheet has A, B, and C tab all contained the same table but different data. When this worksheet is open all the groups are ungrouped.

It contained the following three column groups

1. E1-F1
2. H1-O1
3. R1-AA1

And the following three row groups

1. 112 – 12
2. 129 -137
3. 142 – 160

Currently, I am using these macros to group and ungroup the column and row groups for each A, B and C tab.

Sub GroupCOPY()
    ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
    ActiveSheet.Outline.ShowLevels RowLevels:=1
End Sub
Sub FULLSPREADSHEET()
    ActiveSheet.Outline.ShowLevels RowLevels:=2
    ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=2
End Sub

However, I have modified your MacroGroup script to automate this process for all the tabs but it is working well. See below.
Would you please help me modify MacroGroup vb script to do the following:

Base on the Y or N value in the "AF1" cell.

1. If it is Y then close the entire column and row groups and ungroup Column S and T
2. If it is N then close the entire column and row groups and ungroup P and Q columns

​

I have modified my second “Sub FULLSPREADSHEET()” macro for ungrouping entire column and row groups in A,B, and C tabs and it working well.

Sub GroupCOPY() ' This is the modified version and it is not working well. 
'
'    ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1'
'    ActiveSheet.Outline.ShowLevels RowLevels:=1
Dim ws As Worksheet
 
On Error Resume Next
For Each ws In Sheets(Array("A", "B"))
    If Cells(1, AF).Value = "Y" Then
        'ws.Outline.ShowLevels ColumnLevels:=2
        ws.Columns("S:T").Columns.Ungroup
        ws.Columns("P:Q").Columns.Group
        ws.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
        ws.Outline.ShowLevels RowLevels:=1
        ElseIf Cells(1, AF).Value = "N" Then
           'ws.Outline.ShowLevels ColumnLevels:=2
            ws.Columns("P:Q").Columns.Ungroup
            ws.Columns("S:T").Columns.Group
            ws.Outline.ShowLevels RowLevels:=0, ColumnLevels:=1
            ws.Outline.ShowLevels RowLevels:=1
        End If
    End If
Next ws
 
End Sub


   
Sub FULLSPREADSHEET()[COLOR=#ff0000] ' This macro is assigned to a button for ungrouping entire groups in A,B,C tab and with works well.[/COLOR]  
'
' FULLSPREADSHEET Macro
'    ActiveSheet.Outline.ShowLevels RowLevels:=2
'    ActiveSheet.Outline.ShowLevels RowLevels:=0, ColumnLevels:=2
   
Dim ws As Worksheet
 
On Error Resume Next
For Each ws In Sheets(Array("A", "B", "C"))
        ws.Outline.ShowLevels RowLevels:=2
        ws.Outline.ShowLevels RowLevels:=0, ColumnLevels:=2
Next ws
 
End Sub

Thank you!

 

[YAZ2015]

See above post. Thank you.