Dear NG,

I started a thread about Outlines before ... but got a bit stuck on
MULTI-level outlining.

Summary:
-The grouping should be based on a condition in column B:
ie: Is the font of this cell BOLD?
-Evaluation of this condition always starts on row 7.

Dave Peterson (thanks Dave!)tried to understand what I want to do and
we ended up with the following visualisation of my problem:

My visualisation:
B7:NOT
B8:NOT
1 B9:BOLD =outline level1 (grouping row7-8)
B10:NOT
B11:NOT
B12:NOT
2 B13:BOLD =outline level1 (grouping row10-12)
B14:NOT
3 B15:BOLD =outline level1 (grouping row14)
B16:NOT
B17:NOT
4 B18:BOLD =outline level1 (grouping row 16-17)
1 B19:BOLD = outline level2 (grouping row 7-18)
B20:NOT
5 B21:BOLD =outline level1 (grouping row20)
B22:NOT
B23:NOT
6 B24:BOLD = outline level1 (grouping row22-23)
5 B25:BOLD = outline level2 (grouping row20-24)
1 B26:BOLD = Outline level3 (grouping row 7-25)

Dave says:
The numbers were my feeble attempt to "group" the rows.
1 is a new group, 2 is a new group, 3 a new group, 4 a new group.
But B19 is grouped with top of group 1
5 & 6 (b21 & b24) are new groups
But 5 (b25) is grouped with 5
Why would B26 jump all the way back to 1 (and not 4)?
(rest of discussion on thread:Outlining with condition?)

Sige says:
Level-2 outlines group all the level-1 outlines which are ABOVE...until
it meets another level-2 outline

Level-3 outlines group all the level-2 outlines which are ABOVE
....untill it meets another level 3 outline

Level-4 group all Level-3 outlines which are ABOVE
....untill it meets another level 4 outline
....

ANY Wizard who is able to help me out to set the Multi-Level outlining,
please?

Please please please, Sige



PS: I can mail you an excel-sheet with some manually set outlines on if
it could help you to better see my problem.

Dave's first attempt was already a step in the right direction
Option Explicit
Sub testme2()
Dim wks As Worksheet
Dim NextBoldCell As Range
Dim CurBoldCell As Range
Dim RowDiff As Long
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long

Set wks = Worksheets("Sheet1")
wks.Rows.ClearOutline 'clear previous testing

With wks
FirstRow = 6
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
'end with a bold cell
With .Cells(LastRow, "B")
.Value = "DUMMY"
.Font.Bold = True
End With

Set CurBoldCell = .Cells(FirstRow, "B")

For iRow = FirstRow + 1 To LastRow
If IsBold(.Cells(iRow, "B")) Then
Set NextBoldCell = .Cells(iRow, "B")
RowDiff = NextBoldCell.Row - CurBoldCell.Row
If RowDiff 1 Then
'.Rows(NextBoldCell.Row + 1).Resize(RowDiff -
1).Select
.Rows(CurBoldCell.Row + 1).Resize(RowDiff -
1).Group
End If
If IsBold(NextBoldCell.Offset(1, 0)) Then
'don't change starting point
Else
Set CurBoldCell = NextBoldCell
End If
End If

Next iRow
With .Cells(.Rows.Count, "B").End(xlUp)
.ClearContents
.Font.Bold = False
End With
End With
End Sub

Function IsBold(myCell As Range) As Boolean
IsBold = False
If myCell(1).Font.Bold = True Then
IsBold = True
End If
End Function