PDA

View Full Version : Ungrouping all Row and Column ranges in workbook



xluser2007
05-26-2008, 05:41 PM
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
05-26-2008, 08:25 PM
Try this for ungrouping:

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

xluser2007
05-26-2008, 09:40 PM
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
05-27-2008, 12:27 AM
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.

xld
05-27-2008, 12:58 AM
ActiveSheet.Outline.ShowLevels ColumnLevels:=1
ActiveSheet.Outline.ShowLevels RowLevels:=1

xluser2007
05-27-2008, 04:46 AM
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
05-28-2008, 04:58 AM
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
05-29-2008, 03:37 AM
Is it possible to determine what the max number of Rowlevels/ Columnlevels are for each worksheet in a workbook?


regards

xld
05-29-2008, 06:47 AM
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
05-29-2008, 04:30 PM
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,

xld
05-30-2008, 01:59 AM
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
05-30-2008, 03:55 AM
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,

xld
05-30-2008, 04:40 AM
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

xld
05-30-2008, 04:42 AM
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

xld
05-30-2008, 04:46 AM
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
05-30-2008, 05:22 AM
Lol your Lordship!, have you actually found a thread that intrigues and excites you?

xld
05-30-2008, 05:38 AM
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
05-30-2008, 05:45 PM
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
04-05-2009, 03:31 AM
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
04-05-2009, 03:45 AM
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
04-06-2009, 03:24 PM
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.