• 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: Ungroup rows of level 2

B

Buddha_420

New Member
Hello guys,

I'm running a macro to conditionally group rows based on cell values (if cell in column B = "n/a"). The thing is that I want some rows to remain grouped at all time and have some of these already grouped rows to be grouped to level 2 if the aforementioned condition is met.

The issue with the code below is that if I run the macro more than once, some rows will be grouped more than twice (which is what I want to avoid). I thus need to have level 2 grouped rows to be ungrouped before checking for the condition and grouping but can't find the code for that.


Thanks for helping!




See the code below:
Code: 
Option Explicit
Sub GroupRows()
Dim rData, rCel As Range
Set rData = Range("b47", Range("b" & Rows.Count).End(xlUp))

Application.ScreenUpdating = False
With rData
On Error Resume Next
.Rows.EntireRow.Hidden = False
On Error GoTo 0
End With
For Each rCel In rData
If rCel = "END" Then Exit For
If rCel = "n/a" Then
Rows(rCel.Row).Group
rCel.EntireRow.Hidden = True
End If
Next
Application.ScreenUpdating = True


End Sub
 
Last edited by a moderator:
Check it.

Code: 
Option Explicit
Sub GroupRows1()
Dim rData As Range, rCel As Range
Set rData = Range("b47", Range("b" & Rows.Count).End(xlUp))

Application.ScreenUpdating = False
rData.Rows.EntireRow.Hidden = False
rData.ClearOutline

For Each rCel In rData
    If rCel = "END" Then Exit For
        If rCel = "n/a" Then
            Rows(rCel.Row).Group
                rCel.EntireRow.Hidden = True
        End If
Next
Application.ScreenUpdating = True


End Sub
 
Thanks Deepak for trying. Unfortunately, this ungroups rows at level 1, I'd like them to remain grouped...

Deepak said:
Check it.

Code: 
Option Explicit
Sub GroupRows1()
Dim rData As Range, rCel As Range
Set rData = Range("b47", Range("b" & Rows.Count).End(xlUp))

Application.ScreenUpdating = False
rData.Rows.EntireRow.Hidden = False
rData.ClearOutline

For Each rCel In rData
    If rCel = "END" Then Exit For
        If rCel = "n/a" Then
            Rows(rCel.Row).Group
                rCel.EntireRow.Hidden = True
        End If
Next
Application.ScreenUpdating = True


End Sub
Click to expand...
 
This one.

Code: 
Sub GroupRows1()
Dim rData As Range, rCel As Range
Set rData = Range("b47", Range("b" & Rows.Count).End(xlUp))

Application.ScreenUpdating = False
rData.Rows.EntireRow.Hidden = False

For Each rCel In rData
    If rCel = "END" Then Exit For
        If rCel = "n/a" Then
            rCel.ClearOutline
            Rows(rCel.Row).Group
                rCel.EntireRow.Hidden = True
        End If
Next
Application.ScreenUpdating = True


End Sub
 
We're getting there... :)

But there's still something that bothers be: if the condition is no longer true (once you've revised the data), the row should be ungrouped (ungrouped at level 2 only, not level 1 --> so you can't just ungroup everything before checking for the condition).

Thanks a lot though :)

Deepak said:
This one.

Code: 
Sub GroupRows1()
Dim rData As Range, rCel As Range
Set rData = Range("b47", Range("b" & Rows.Count).End(xlUp))

Application.ScreenUpdating = False
rData.Rows.EntireRow.Hidden = False

For Each rCel In rData
    If rCel = "END" Then Exit For
        If rCel = "n/a" Then
            rCel.ClearOutline
            Rows(rCel.Row).Group
                rCel.EntireRow.Hidden = True
        End If
Next
Application.ScreenUpdating = True


End Sub
Click to expand...
 
replace it & check.

Code: 
For Each rCel In rData
rCel.ClearOutline
    If rCel = "END" Then Exit For
        If rCel = "n/a" Then: Rows(rCel.Row).Group: rCel.EntireRow.Hidden = True
Next
 
Here's an extract of my model. On the cover tab, you can enter brand/category names. These feed the dashboard tab, which has a large number of rows for inputs.

I don't know yet which brands/categories will be modeled and which ones will be "n/a". Which is why I might have to run the macro several times. For the moment you have only 6 categories/brands per country.

There's a button to run the macro on top of the second tab. If you click it twice, whether you changed or not the categories/brands referred to as "n/a" on the cover tab, this gives you "random" grouping of rows on the dashboard tab.

Hope this makes things clearer. Let me know if you need further details.

Really appreciate the help Deepak!


Deepak said:
Can we have the xl with said thoughts.
Click to expand...
 

Attachments

Deepak said:
Can we have the xl with said thoughts.
Click to expand...

Deepak,

I figured it may be easier to adapt the Dashboard tab (see the new version attached) and adjust the code to do it in two sequences:


First, ungroup everything and group rows where you have “Y” in column CY.

Second, group rows where you have “n/a” in column B.


I tried to adjust the code but as you can see, I’m far from being an expert in VBA. How can I have the code check successively column CY for “Y” et then in column B for “n/a”.


Hope I’ve been clear…
 

Attachments

Check this.

Code: 
Sub group1()
ActiveSheet.Cells.ClearOutline
Dim x As Range, varx As Variant, s As String, i As Integer
Dim sp As Variant

Application.ScreenUpdating = False
Set x = Columns("CY").Find("End")
s = "=TRANSPOSE(IF(CY1:CY" & x.Row & "=""Y"",ADDRESS(ROW(CY1:CY" & x.Row & "),103)))"
varx = Join(Filter(Evaluate(s), False, False), ",")
sp = Split(varx, ",")

For i = 0 To UBound(sp)
    Range(sp(i)).Rows.Group
Next

s = "=TRANSPOSE(IF(b1:b" & x.Row & "=""n/a"",ADDRESS(ROW(b1:b" & x.Row & "),103)))"
varx = Join(Filter(Evaluate(s), False, False), ",")
sp = Split(varx, ",")

For i = 0 To UBound(sp)
    Range(sp(i)).Rows.Group
Next

Application.ScreenUpdating = True

End Sub
 
Deepak said:
Check this.

Code: 
Sub group1()
ActiveSheet.Cells.ClearOutline
Dim x As Range, varx As Variant, s As String, i As Integer
Dim sp As Variant

Application.ScreenUpdating = False
Set x = Columns("CY").Find("End")
s = "=TRANSPOSE(IF(CY1:CY" & x.Row & "=""Y"",ADDRESS(ROW(CY1:CY" & x.Row & "),103)))"
varx = Join(Filter(Evaluate(s), False, False), ",")
sp = Split(varx, ",")

For i = 0 To UBound(sp)
    Range(sp(i)).Rows.Group
Next

s = "=TRANSPOSE(IF(b1:b" & x.Row & "=""n/a"",ADDRESS(ROW(b1:b" & x.Row & "),103)))"
varx = Join(Filter(Evaluate(s), False, False), ",")
sp = Split(varx, ",")

For i = 0 To UBound(sp)
    Range(sp(i)).Rows.Group
Next

Application.ScreenUpdating = True

End Sub
Click to expand...


Deepak, you're such a legend!
Thanks so much for helping. Works perfectly!
 
Code: 
Sub group2()
ActiveSheet.Cells.ClearOutline
Dim x As Range, varx As Variant, s As String, i As Integer, rng As Range
Dim sp As Variant

Application.ScreenUpdating = False

Set x = Columns("CY").Find("End"):  Set rng = Range([CY1], x) ' if need then change column here - CY

s = "=TRANSPOSE(IF(" & rng.Address & "=""Y"",ADDRESS(ROW(" & rng.Address & "),1)))"
varx = Join(Filter(Evaluate(s), False, False), ","):    sp = Split(varx, ",")

For i = 0 To UBound(sp)
    Range(sp(i)).Rows.Group
Next

Set rng = Nothing:  Set rng = Range([B1], Range("B" & x.Row)) ' if need then change column here - B

s = "=TRANSPOSE(IF(" & rng.Address & "=""n/a"",ADDRESS(ROW(" & rng.Address & "),1)))"
varx = Join(Filter(Evaluate(s), False, False), ","):    sp = Split(varx, ",")

For i = 0 To UBound(sp)
    Range(sp(i)).Rows.Group
Next

Set rng = Nothing: Set x = Nothing

Application.ScreenUpdating = True

End Sub
 
You must log in or register to reply here.
Back
Top