• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Grouping ungrouping data on a single click

ThrottleWorks

Excel Ninja
My friend is facing this problem.

I have a data, column A

Range A1 is header for example Sachin.

From Range A2 there are name of the regions.

This range is flexible can be A50 or A100 also.


We want to design a macro which will be triggered by an event.

If the user clicks on Range A1 the list should collapse, if he clicks it again, the list should expand.


I had discussed grouping option with him, but he does not want that.


Is it possible to do it, another problem is the current file is macro free.

Is it possible to do it without macro.


Can anyone help me in this please.
 
Sachinbizboy


You can select Rows 2:100

Ctrl+Alt+Right Arrow

This will group the rows and allow you to collapse them


You can select Rows 2:100

Ctrl+Alt+Left Arrow

This will ungroup the rows


Otherwise this can be done by using some VBA code and clicking on A1
 
Heres's the VBA Code


Copy and paste the following in the Worksheet module in VBA for the worksheet you want to apply this to

[pre]
Code:
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Target.Address <> "$A$1" Then Exit Sub
If Range("A2").Rows.OutlineLevel > 1 Then
Range("A2", Range("A2").End(xlDown)).Rows.Ungroup
Else
Range("A2", Range("A2").End(xlDown)).Rows.Group
End If

End Sub
[/pre]
 
Hui Sir, thanks a lot for the help and your valuable time, I will do this, wil share the results, have a very nice weekend, sorry for late reply.
 
Sachinbizboy


The code below works a lot better than that above

You click in A1 and it will shrink everything below it

Click out of A1 and then Back into a1 to Expand everything again

[pre]
Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Target.Address <> "$A$1" Then Exit Sub
If Range("A2").Rows.OutlineLevel > 1 Then
Range("A2", Range("A2").End(xlDown)).Rows.Ungroup
Range("A2", Range("A2").End(xlDown)).EntireRow.Hidden = False
Else
Range("A2", Range("A2").End(xlDown)).Rows.Group
ActiveSheet.Outline.ShowLevels RowLevels:=1
End If

End Sub
[/pre]
 
Hui Sir I do not know how to thank you, you are taking this effort for me that too on a weekend, thanks a lot, could not do it today, will do it tomorrow, have a nice weekend. Sachin
 
Back
Top