Grouping Based on Indent

[ryguy7272]

I was working with the below code for a few weeks:
Sub Grp()
Dim lngRow As Long
Sheets("Sheet1").Select
For i = 10 To 0 Step -2
For lngRow = Cells(Rows.Count, "B").End(xlUp).Row To 9 Step -1
If Range("B" & lngRow) <> "" And Left(Range("B" & lngRow), i) = Space(i) Then
Range("B" & lngRow & ":B" & lngRow).Rows.Group
End If
Next lngRow
Next i
End Sub

It works great for grouping cells based on spaces in front of the cells (0,
2, 4, 6, 8, or 10 spaces). What I’m trying to do now is modify the code
above to group cells based on the IndentLevel.

I am trying to modify this now (to do grouping based on IndentLevel):
Sub Grp()
Dim lngRow As Long
Sheets("Sheet1").Select
For i = 6 To 0 Step -1
For lngRow = Cells(Rows.Count, "B").End(xlUp).Row To 2 Step -1
If Range("B" & lngRow).IndentLevel > 0 And Range("B" & lngRow).IndentLevel =
(i) Then
Range("B" & lngRow & ":B" & lngRow).Rows.Group
End If
Next lngRow
Next i
End Sub

All this code does though, is give me one giant grouping; no sub-groups.

Jacob Skaria was kind enough to give me some code a few days ago. When I
ran it, it seemed to work on a small sample, but on a larger sample it didn’t
group appropriately. Specifically, it always seems to miss the last grouping
in any group.

I’ve spent a couple of hours on this, and haven’t been able to figure it out
yet. Does anyone know how to do this grouping, and get the last group in a
list, so that it rolls up into the whole list appropriately?

Thanks,
Ryan---

 

[Jacob Skaria]

Hi Ryan

I remember using an array. Will check and get back to you..

If this post helps click Yes

 

[Jacob Skaria]

Ryan,

I have spent some time on this.. Just a quick query..For the project plan
grouping..do you have a cut off for the indent level...like upto level 4 or
upto level 6...coz the current one which I am working on is unlimited
levels... which would require more than a loop..

If this post helps click Yes

 

[Jacob Skaria]

Dear Ryan

Insert a new module and paste the below code. The main procedure is
GroupbyIndexLevels() and the sub procedure is GroupRows(). Please do test and
I will wait for your feedback..

Dim arrIndent As Variant

Sub GroupbyIndexLevels()
Dim lngRow As Long
Dim intIndent As Integer
ReDim arrIndent(0)
For lngRow = 1 To Cells(Rows.Count, "B").End(xlUp).Row
If Range("B" & lngRow).IndentLevel > 0 Then
intIndent = Range("B" & lngRow).IndentLevel

If intIndent = 1 And UBound(arrIndent) > 0 Then
GroupRows lngRow
Else
If intIndent < Range("B" & lngRow + 1).IndentLevel Then
If intIndent > UBound(arrIndent) Then _
ReDim Preserve arrIndent(intIndent)
arrIndent(intIndent) = arrIndent(intIndent) & "," & lngRow
End If

If intIndent < Range("B" & lngRow - 1).IndentLevel Then
If intIndent > UBound(arrIndent) Then _
ReDim Preserve arrIndent(intIndent)
arrIndent(intIndent) = arrIndent(intIndent) & "," & lngRow
End If
End If

End If
Next lngRow
If intIndent <> 1 Then GroupRows lngRow
ActiveSheet.Outline.ShowLevels RowLevels:=1
End Sub

Sub GroupRows(lngRow As Long)
Dim intTemp As Integer
Dim intCount As Integer
Dim arrTemp As Variant

For intTemp = 1 To UBound(arrIndent)
arrTemp = Split(arrIndent(intTemp) & "," & lngRow, ",")
For intCount = 1 To UBound(arrTemp) Step 2
Rows(arrTemp(intCount) + 1 & ":" & arrTemp(intCount + 1) - 1).Group
Next
Next

ReDim arrIndent(1)
arrIndent(1) = "," & lngRow
End Sub

 

[ryguy7272]

I can tell that a lot of time and effort went into this! Thanks Jacob!!


Rows(arrTemp(intCount) + 1 & ":" & arrTemp(intCount - 1) + 1).Group

Message: Run-Time Error 13: Type Mismatch

So, I added this:

On Error Resume Next

Then, I noticed the grouping seemed kind of weird, so I added this:

Rows(arrTemp(intCount) + 1 & ":" & arrTemp(intCount + 1) +
intIndent).Group

Well, just substituted the intIndent for the 1

Seems to work now!! Would you like to try the above and get back to me?

Again, THANKS JAOCB!!

Ryan---

 

[Jacob Skaria]

If you notice the grouping line in the code i pasted is
Rows(arrTemp(intCount) + 1 & ":" & arrTemp(intCount + 1) - 1).Group

and not
Rows(arrTemp(intCount) + 1 & ":" & arrTemp(intCount - 1) + 1).Group
which you have mentioned as returning error. Was that a typo?

PS: Forgot to mention something. The one item with indent level 3 will also
be grouped; so that when you view level 2 items this item will not be
displayed.

If this post helps click Yes

 

[Jacob Skaria]

Hi Ryan

Revised solution for grouping. Insert a new module and copy the below code.
Number of indent levels is not fixed however in the below code either you
change the upper bound of the array OR as in the previous solution you can
re-dimension it at run-time. But i assume it wont run to more than 10 indent
levels..I have tested with few test cases. Try and feedback...


Dim arrINT(10) As Long
Sub GroupbyIndexLevels2()
Dim lngRow As Long
Dim intCIL As Integer
Dim intPIL As Integer
For lngRow = 1 To Cells(Rows.Count, "B").End(xlUp).Row
intCIL = Range("B" & lngRow).IndentLevel
If intCIL > 0 Then
If intCIL > intPIL Then
arrINT(intCIL) = lngRow
ElseIf intCIL < intPIL Then
GroupRows2 intCIL, lngRow
End If
intPIL = intCIL
End If
Next lngRow
GroupRows2 1, lngRow
ActiveSheet.Outline.ShowLevels RowLevels:=1
End Sub

Sub GroupRows2(intIND As Integer, lngRow As Long)
Dim intTemp As Integer
For intTemp = intIND + 1 To UBound(arrINT)
If arrINT(intTemp) <> 0 Then
Rows(arrINT(intTemp) & ":" & lngRow - 1).Group
arrINT(intTemp) = 0
End If
Next
End Sub


If this post helps click Yes

 

[ryguy7272]

This seems to work flawlessly! Thanks so much, Jacob, for seeing it through
to the end!!!
Ryan--