• 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.

VBA Code to Collapse Row Groups based on Group Name

P

Phillycheese

New Member
Hi,
I have a report that has 50+ countries grouped with a row outline with the summary at the top. There are several countries that I would like to hide based on their name in column "A". I tried recording a macro but clicking the plus and minus buttons do not create any code. I found some code that hides or shows all groups, but I would like to only hide specific groups.
Any suggestions would be appreciated.
Thanks,
Phillycheese
 
Hey Luke,
Thanks for the link, although it's a bit over my head. I was hoping to find code that works in this sort of fashion:
if there is a cell in A:A with "Japan", then collapse that particular group.
If you have any ideas how to get that idea into VBA that would be great!
Phillycheese
 
Hey Luke,
That's pretty cool! I tried it out and also added another country by duplicating the line that had Find("Japan") and it worked okay. Thanks again for the help!!
Phillycheese
 
Hey Luke,
I may have misspoke when I said I added another country by duplicating the line and it worked. I can get one country to hide but not additional ones. I have 6 sheets in my file where I want to collapse several specific groups---I tried moving the code from the Modules to the "ThisWorkbook" and then to individual sheets but that didn't help. Would you be able to tell me how to put additional countries into the code that I would like to collapse?
Phillycheese
 
Not a problem. One idea would be to have list of the countries somewhere, and have the code run a loop. Like this:
Code: 
Sub OutlineTest()
Dim fCell As Range
Dim firstAdd As String
Dim rngHideThese
Dim c As Range

'Where is list of items to hide?
Set rngHideThese = Worksheets("Sheet2").Range("D1:D10")

Application.ScreenUpdating = False
'Loop over our list of countries
For Each c In rngHideThese
    With ActiveSheet.Range("A:A")
        'Try to find our value
        Set fCell = .Find(c.Value)
       
        'Error check
        If fCell Is Nothing Then
            MsgBox "Couldn't find value"
            Exit Sub
        Else
            firstAdd = fCell.Address
        End If
       
        'Loop over cell(s)
        Do
            fCell.EntireRow.ShowDetail = False
           
            Set fCell = .FindNext(fCell)
        Loop Until fCell.Address = firstAdd
       
    End With
Next c
Application.ScreenUpdating = True

End Sub
 
Hey Luke,
I like that idea of keeping the groups in a central spot. Right now the macro is in Module2 and it works great. I added a line right before the screen-updating=false to specify the sheet because the macro uses "activesheet". Since I have 6 different sheets where I want to apply the macro, should I create 6 Modules or is there a way to tell the macro to run on multiple sheets? I really appreciate the ninja skills :)
Phillycheese
 
Loops within loops! :cool: Simply edit the wsNames array as needed, with each name separated by a comma.
Code: 
Sub OutlineTest()
Dim fCell As Range
Dim firstAdd As String
Dim rngHideThese
Dim c As Range
Dim wsNames As Variant
Dim wsI As Long
Dim ws As Worksheet

'---CHANGE SHEET AND RANGE NAMES HERE---
'Where is list of items to hide?
Set rngHideThese = Worksheets("Sheet2").Range("D1:D10")
'Which worksheets to search?
wsNames = Array("Sheet1", "Sheet3", "Sheet4")
'----------------------------------------

Application.ScreenUpdating = False
'Loop over list of sheets
For wsI = LBound(wsNames) To UBound(wsNames)
    Set ws = Worksheets(wsNames(wsI))
    'Loop over our list of countries
    For Each c In rngHideThese
        With ws.Range("A:A")
            'Try to find our value
           Set fCell = .Find(c.Value)
         
            'Error check
           If fCell Is Nothing Then
                MsgBox "Couldn't find value"
                Exit Sub
            Else
                firstAdd = fCell.Address
            End If
         
            'Loop over cell(s)
           Do
                fCell.EntireRow.ShowDetail = False
             
                Set fCell = .FindNext(fCell)
            Loop Until fCell.Address = firstAdd
         
        End With
    Next c
Next wsI
Application.ScreenUpdating = True

End Sub
 
Hey Luke,
It's been a while! This code worked great but now I have an issue and I think I know why, but I can't fix it. Basically, I used to have the expand/collapse group headings in column A and my other data labels in columns B. But now the output format has changed so all my data headings and data item labels are in column A. So when the VBA looks for "Japan" it will collapse it, and then it will collapse any other groups if any of the data labels happen to have the word "Japanese". Is there any way to have it look for the exact match so I can only target the group headings?
Please let me know.
Thanks,
Phillycheese
 
Change this line:
Set fCell = .Find(c.Value)

to this
Set fCell = .Find(what:=c.Value, lookat:=xlWhole)

and that will make sure it only does a complete match.
 
You must log in or register to reply here.
Back
Top