Ungrouping all Row and Column ranges in workbook

[xluser2007]

Hi All,

I have a workbook that has many multiple grouped column ranges and row ranges.

I would like a button to ungroup all columns/ rows and regroup all columns rows.

Here is what i experimented with and found from the web (http://www.experts-exchange.com/Programming/Languages/Visual_Basic/Q_23124188.html)

NOTE: macro recorder didn't register anything when I tried to record the ungrouping of a column for example.


Option Explicit

Sub Ungroup_all_Worksheets_in_This_Workbook()
Dim wksht As Worksheet
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
For Each wksht In ThisWorkbook.Worksheets
wksht.Outline.ShowLevels RowLevels:=2, columnlevels:=2
Next
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub

The issues with the above macro are:

It is quite slow on a 19MB workbook even with screenupdating and calculation turned to manual at the start. Not sure why?
It does not ungroup all columns/ rows there are still some that remain grouped.

Could any VB Gurus please help to amend for the above 2 issues and help me understand why they are occcurring.

regards,

[Simon Lloyd]

Try this for ungrouping:


Sub ShtUngroup()
With ActiveSheet.UsedRange
.Rows.EntireRow.Hidden = False
.Columns.EntireColumn.Hidden = False
.Ungroup
.ClearOutline
End With
End Sub

[xluser2007]

Simon, thanks for your reply.

I tested your code, by commenting out various sections and but didn't quite give me what i wanted.

My post-title, I realise, is somewhat misleading. I actually want the macro to collapse ALL the groups (i.e. click GROUP plus signs) and uncollapse ALL the groups (click the group minus signs).

When I run your macro as follows:


Sub ShtUngroup()
With ActiveSheet.UsedRange
' .Rows.EntireRow.Hidden = False
' .Columns.EntireColumn.Hidden = False
.Ungroup
.ClearOutline
End With
End Sub
This removes ALL groupings due to the ".ClearOutline " command (useful to know :)).

When I run as follows:


Sub ShtUngroup()
With ActiveSheet.UsedRange
' .Rows.EntireRow.Hidden = False
' .Columns.EntireColumn.Hidden = False
.Ungroup
' .ClearOutline
End With
End Sub

It ungroups the largest group in the UsedRange (also useful to know :)), but not what I'm after.

Any ideas to achieve my purpose as better stated in this post.

If it's still unclear I'm happy to reclarify.

Cheers,

[Simon Lloyd]

Maybe you want something like this:


ExecuteExcel4Macro "SHOW.DETAIL(1,17,TRUE,,0)"

where the 1,17 are rows 1 to 17 however, i recorded my actions going to Data, Groups, Show detail and then hide detail, the code you get cannot be altered or at least when i tried altering it i had problems running the code again.

[Bob Phillips]

ActiveSheet.Outline.ShowLevels ColumnLevels:=1
ActiveSheet.Outline.ShowLevels RowLevels:=1

[xluser2007]

Hi Simon, Bob,

Thank you for your replies and interest.

Simon, I should have recorded as you did and tried to get more code out the recording experiment. Although the code you have put up seems to be an old sort of coding (Excel4 macros ?) and thus difficult to use. Thanks for your efforts though.

Bob, yep your code did the trick of COLLAPSING all groups (as Rowlevel, columnlevel = 1 is by default the lowest group). Thanks for this solution.

You have however caused me to understand how to generalise this problem further. I've attached a sample workbook with 3 sheets and many combinations of grouped columns and rows. Key is the number of groupings for rows and columns varies by worksheet.

How would one, in any general workbook use VBA to:

Display the total number of Grouped Rowlevels and ColumnLevels per worksheet.
Ungroup all rows in a worksheet (requires part 1 the max Rowlevel for that worksheet)
Ungroup all columns in a worksheet (requires part 1 the max Columnlevel for that worksheet)
Ungroup all but a specific column/ or row group in a specific worksheet e.g. in the attached workbook, Sheet2, If I want to Group only the columns G-I, how would I specify to this level in VBA?
What sort of error handling would be put in a macro like this? e.g. for a macro to switch of all autofilters in a workbook, you would require to check if a filter existsts first and then turn off the autofilter. Are there any such checks for groupings that need to be done?Would appreciate your insights into the above.

Kind regards,

[xluser2007]

Bob, Simon,

Is the level of customisation or flexibility possible with VBA for grouping and ungrouping rows/ cols in Excel (as described in the questions in my previous post)?

The MSDN article on Showlevels (http://msdn.microsoft.com/en-us/library/aa172680%28office.11%29.aspx) for example is not that informative (in fact I've learnt more about the properties from this forum post, and VBA help didn't come up with anything). I'm hoping to learn more from you based on my previous set of questions on grouping and ungrouping.

Please let me know.

regards

[xluser2007]

Is it possible to determine what the max number of Rowlevels/ Columnlevels are for each worksheet in a workbook?


regards

[Bob Phillips]

Best I could do, a function that goes through counting them


Public Function CountLevels(ByRef sh As Worksheet, Optional ByVal ByRows As Boolean = True)
Dim NumToTry As Long
Dim LastRowCol As Long
Dim RowLevel As Long
Dim ColLevel As Long
Dim LevelToTry As Long
Dim CurrentLevel As Long
Dim NumVisible As Long
With sh
If ByRows Then
NumVisible = .UsedRange.Columns(1).SpecialCells(xlVisible).Count
Else
NumVisible = .UsedRange.Rows(1).SpecialCells(xlVisible).Count
End If
LevelToTry = 1
Do
RowLevel = IIf(ByRows, LevelToTry, 0)
ColLevel = IIf(ByRows, 0, LevelToTry)
.Outline.ShowLevels RowLevel, ColLevel
If ByRows Then
NumToTry = .UsedRange.Columns(1).SpecialCells(xlVisible).Count
Else
NumToTry = .UsedRange.Rows(1).SpecialCells(xlVisible).Count
End If
If NumToTry = NumVisible Then CurrentLevel = LevelToTry
If LevelToTry > 1 Then
If NumToTry = LastRowCol Then Exit Do
ElseIf (ByRows And NumToTry = .UsedRange.Rows.Count) Or _
(Not ByRows And NumToTry = .UsedRange.Columns.Count) Then
Exit Do ' no levels
End If
LastRowCol = NumToTry
LevelToTry = LevelToTry + 1
Loop
' replace the previous number of levels
If ByRows Then
.Outline.ShowLevels CurrentLevel
Else
.Outline.ShowLevels 0, CurrentLevel
End If
End With
CountLevels = LevelToTry - 1
End Function

[xluser2007]

Bob, your skills are amazing.

Thank you for helping me realise that this is not as trivial as it sounds and helping to understand how to count levels in Excel.

I tested on the workbook I posted in the earlier post as follows (only change I made to your code is the Debug.print at the bottom):


Option Explicit

Public Function CountLevels(ByRef sh As Worksheet, Optional ByVal ByRows As Boolean = True)
Dim NumToTry As Long
Dim LastRowCol As Long
Dim RowLevel As Long
Dim ColLevel As Long
Dim LevelToTry As Long
Dim CurrentLevel As Long
Dim NumVisible As Long
With sh
If ByRows Then
NumVisible = .UsedRange.Columns(1).SpecialCells(xlVisible).Count
Else
NumVisible = .UsedRange.Rows(1).SpecialCells(xlVisible).Count
End If
LevelToTry = 1
Do
RowLevel = IIf(ByRows, LevelToTry, 0)
ColLevel = IIf(ByRows, 0, LevelToTry)
.Outline.ShowLevels RowLevel, ColLevel
If ByRows Then
NumToTry = .UsedRange.Columns(1).SpecialCells(xlVisible).Count
Else
NumToTry = .UsedRange.Rows(1).SpecialCells(xlVisible).Count
End If
If NumToTry = NumVisible Then CurrentLevel = LevelToTry
If LevelToTry > 1 Then
If NumToTry = LastRowCol Then Exit Do
ElseIf (ByRows And NumToTry = .UsedRange.Rows.Count) Or _
(Not ByRows And NumToTry = .UsedRange.Columns.Count) Then
Exit Do ' no levels
End If
LastRowCol = NumToTry
LevelToTry = LevelToTry + 1
Loop
' replace the previous number of levels
If ByRows Then
.Outline.ShowLevels CurrentLevel
Else
.Outline.ShowLevels 0, CurrentLevel
End If
End With
CountLevels = LevelToTry - 1
Debug.Print CountLevels
End Function

Sub testcount()
Dim wksht As Worksheet
Set wksht = ThisWorkbook.Sheets("Sheet3")
Call CountLevels(wksht, True) ' This counts ROWS
Call CountLevels(wksht, False) ' This counts COLUMNS
'Clear objects from memory
Set wksht = Nothing
End Sub

The routine caused an error for this line:

Call CountLevels(wksht, False) ' This counts COLUMNS
And then highlighted the following line:


NumVisible = .UsedRange.Rows(1).SpecialCells(xlVisible).Count
Please let me know if I am doing anything wrong. Do the rows and columns have to be collpased before running your countlevels function?

Again appreciate your efforts and time on this one.

thanks,

[Bob Phillips]

I just added the code as you posted it to a workbook and it ran fine.

Yo don't have to collapse or un-collapse the rows and columns, as the code saves the current position, then uncollapses it all to count it, then reverts to the original position.

Can you post your workbook?

[xluser2007]

Hi Bob,

Firstly, a very well deserved title under your Avatar :thumb!

The workbook I used was same one I posted up in post #5.

I just put the code from my previous post in a module.

regards,

[Bob Phillips]

LOL! I reproduced the error okay and thought it was really tricky, as your usedrange was within the collapsed rows, so the visible rows count was negligible. My thinking was that I needed to uncollapse the rows when counting columns and vice versa, but I had no idea how many levels to go through - a real circular problem.

Then I tried some real thinking! here is the result


Public Function CountLevels(ByRef sh As Worksheet, Optional ByVal ByRows As Boolean = True)
Dim NumToTry As Long
Dim LastRowCol As Long
Dim RowLevel As Long
Dim ColLevel As Long
Dim LevelToTry As Long
Dim CurrentLevel As Long
Dim NumVisible As Long
With sh
If ByRows Then
NumVisible = .Columns(1).SpecialCells(xlVisible).Count
Else
NumVisible = .Rows(1).SpecialCells(xlVisible).Count
End If
LevelToTry = 1
Do
RowLevel = IIf(ByRows, LevelToTry, 0)
ColLevel = IIf(ByRows, 0, LevelToTry)
.Outline.ShowLevels RowLevel, ColLevel
If ByRows Then
NumToTry = .UsedRange.Columns(1).SpecialCells(xlVisible).Count
Else
NumToTry = .UsedRange.Rows(1).SpecialCells(xlVisible).Count
End If
If NumToTry = NumVisible Then CurrentLevel = LevelToTry
If LevelToTry > 1 Then
If NumToTry = LastRowCol Then Exit Do
ElseIf (ByRows And NumToTry = .UsedRange.Rows.Count) Or _
(Not ByRows And NumToTry = .UsedRange.Columns.Count) Then
Exit Do ' no levels
End If
LastRowCol = NumToTry
LevelToTry = LevelToTry + 1
Loop
' replace the previous number of levels
If ByRows Then
.Outline.ShowLevels CurrentLevel
Else
.Outline.ShowLevels 0, CurrentLevel
End If
End With
CountLevels = LevelToTry - 1
Debug.Print CountLevels
End Function

Sub testcount()
Dim wksht As Worksheet
Set wksht = ThisWorkbook.Sheets("Sheet3")
Call CountLevels(wksht, True) ' This counts ROWS
Call CountLevels(wksht, False) ' This counts COLUMNS
'Clear objects from memory
Set wksht = Nothing
End Sub

[Bob Phillips]

And another way ... I am cooking now, the brain is engaged.


Option Explicit

Public Function CountLevels(ByRef sh As Worksheet, Optional ByVal ByRows As Boolean = True)
Dim NumToTry As Long
Dim LastRowCol As Long
Dim RowLevel As Long
Dim ColLevel As Long
Dim LevelToTry As Long
Dim CurrentLevel As Long
Dim NumVisible As Long
With sh
NumVisible = 1 ' prime it
On Error Resume Next
If ByRows Then
NumVisible = .UsedRange.Columns(1).SpecialCells(xlVisible).Count
Else
NumVisible = .UsedRange.Rows(1).SpecialCells(xlVisible).Count
End If
On Error GoTo 0
LevelToTry = 1
Do
RowLevel = IIf(ByRows, LevelToTry, 0)
ColLevel = IIf(ByRows, 0, LevelToTry)
.Outline.ShowLevels RowLevel, ColLevel
If ByRows Then
NumToTry = .UsedRange.Columns(1).SpecialCells(xlVisible).Count
Else
NumToTry = .UsedRange.Rows(1).SpecialCells(xlVisible).Count
End If
If NumToTry = NumVisible Then CurrentLevel = LevelToTry
If LevelToTry > 1 Then
If NumToTry = LastRowCol Then Exit Do
ElseIf (ByRows And NumToTry = .UsedRange.Rows.Count) Or _
(Not ByRows And NumToTry = .UsedRange.Columns.Count) Then
Exit Do ' no levels
End If
LastRowCol = NumToTry
LevelToTry = LevelToTry + 1
Loop
' replace the previous number of levels
If ByRows Then
.Outline.ShowLevels CurrentLevel
Else
.Outline.ShowLevels 0, CurrentLevel
End If
End With
CountLevels = LevelToTry - 1
Debug.Print CountLevels
End Function

Sub testcount()
Dim wksht As Worksheet
Set wksht = ThisWorkbook.Sheets("Sheet3")
Call CountLevels(wksht, True) ' This counts ROWS
Call CountLevels(wksht, False) ' This counts COLUMNS
'Clear objects from memory
Set wksht = Nothing
End Sub

[Bob Phillips]

Actually, neither of these work with your sheet if there are no grouped rows.

Maybe it is back to my original idea.

I will be back.

[Simon Lloyd]

Lol your Lordship!, have you actually found a thread that intrigues and excites you?

[Bob Phillips]

Yes I have. I have no idea why, as grouping is something I rarely do, and I have completely lost track of xluser2007's big-picture objective, but it is a nice problem.

[xluser2007]

Bob,

It's a real pleasure seeing your thought process in coding.

My apologies for the delayed response. I'm a bit unwell at the moment and am sneaking back very occasioanally to the computer. My interest in this problem has gone up also thanks to your efforts.


Yes I have. I have no idea why, as grouping is something I rarely do, and I have completely lost track of xluser2007's big-picture objective, but it is a nice problem.
Just to clarify this important point. Basically at work we use grouping a lot on some of the large workbooks. Grouping hides the large data processing/ calculations and leaves the final formatted results visible only. Thus the need to GROUP all rows and cloumns (through macros) came about (as doing it worksheet by worksheet by cliscking is very tedious).

To do the opposite of view the data processing/ calculations the (harder) problem of UNGROUPING all rows/ columns came about.

Then after your's and Simon's posts I realised that the problem may not be so trivial, so in Post #5 I got carried away asking more detailed questions like how to ungroup only specific rows/ columns etc.

But I am mainly interested in the UNGROUPING all worksheets in a workbook problem.

Hope this helps & thank you for your interest and efforts on the problem :)

regards

[xluser2007]

Hi Bob,

Hope you are well and that your Excel conference went well.

I was just revisiting this problem for a workrelated issue, in particular for UNGROUPING all row/ column levels in a workbook.

I realised that instead of being able to identify how many group levels there are to ungroup, you can just set it to the highest allowable level i.e. 8 and ungroup to that level, as follows:

' The looping was adapted from:
' http://www.ozgrid.com/forum/showthread.php?t=38064


Sub Remove_Formulas_Activeworkbook()
Dim sh As Worksheet, HidShts As New Collection
For Each sh In ActiveWorkbook.Worksheets
If Not sh.Visible Then
HidShts.Add sh
sh.Visible = xlSheetVisible
End If
' Need some error handling here
sh.Outline.ShowLevels RowLevels:=8
sh.Outline.ShowLevels RowLevels:=8
Next sh
For Each sh In HidShts
' sh.Delete
sh.Visible = xlSheetHidden
Next sh
End Sub
I know this is not rigorous, but seems to work.

Q1: Is 8 the highest allowable level (seeemed to be from experiments) and;
Q2: What do you think of this?

[xluser2007]

Slightly clearer version to previous post:


Sub Ungroup_Regroup_Rows_Columns(strInstruction As String)
Dim wksht As Excel.Worksheet, HidShts As Collection
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Set HidShts = New Collection
For Each wksht In ActiveWorkbook.Worksheets
If Not wksht.Visible Then
HidShts.Add wksht
wksht.Visible = xlSheetVisible
End If

' Can we improve this code for error handling and;
' On a nicer way to optionally specify the strInstruction parameter, default value should be to expand


Select Case strInstruction
Case "Contract"
wksht.Outline.ShowLevels RowLevels:=1
wksht.Outline.ShowLevels ColumnLevels:=1
Case "Expand"
wksht.Outline.ShowLevels RowLevels:=8
wksht.Outline.ShowLevels ColumnLevels:=8
End Select
Next wksht
End Sub

[xluser2007]

Hi Bob,

Did you get a chance to review the above?

Really keen to know your thoughts on themethod and the code, and possible error handling that could be employed.