Grouping Based on Indent
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
--
If this post helps click Yes
---------------
Jacob Skaria
"ryguy7272" wrote:
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 Im 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 didnt
group appropriately. Specifically, it always seems to miss the last grouping
in any group.
Ive spent a couple of hours on this, and havent 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---
--
Ryan---
If this information was helpful, please indicate this by clicking ''Yes''.
|