Try this

[vba]

Public Function SetOutlines()
Dim vecCIs As Variant
Dim Lastrow As Long
Dim i As Long

vecCIs = Array(xlColorIndexNone, 15, 20, 37, 47, 0)
With ActiveSheet

Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

Call OutlineRows(ActiveSheet, 3, Lastrow, vecCIs, 1)
End With
End Function

Private Function OutlineRows( _
ByRef sh As Worksheet, _
ByRef Currentrow As Long, _
ByVal Lastrow As Long, _
ByVal CIs As Variant, _
ByVal ThisCI As Long)
Dim i As Long

With sh

For i = Currentrow To Lastrow

Do Until .Cells(i, "A").Interior.ColorIndex = CIs(ThisCI - 1) Or _
i + 1 > Lastrow

i = i + 1
If .Cells(i, "A").Interior.ColorIndex = CIs(ThisCI + 1) Then

Call OutlineRows(sh, i, Lastrow, CIs, ThisCI + 1)
End If
Loop

If Currentrow = 3 Then Exit Function

If i <= Lastrow Then sh.Rows(Currentrow).Resize(i - Currentrow).Rows.Group

If .Cells(i, "A").Interior.ColorIndex = CIs(ThisCI - 1) Then

Currentrow = i
Exit Function
End If
Next i
End With
End Function
[/vba]