Determine rows containing outline totals

[Michael Simpson]

I have the following code

   Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(5, 6, 7, 8, 9, 10, 11), _
        Replace:=True, PageBreaks:=False, SummaryBelowData:=True
    ' Default is to show subtotals at a bank level
    ActiveSheet.Outline.ShowLevels RowLevels:=2

What I then need to do is loop through the rows for level 2 and set a specific colour in a specific column depending on its value (ie, if the value in column K is >0 , set colour to green, otherwise set to red).

Can someone suggest a good/simple way to do this please ? (Ie, what I need is some way of looping through the rows on the sheet and looking for the totalled lines and then setting the colour thereafter)

 

[Michael Simpson]

This is how I've ended up coding what I need (sort of cheating I suppose based on what I asked for originally, but what the hell).

Private Sub colour_column_totals()
'
' First removes ALL cell colouring in column K, then changes the colour
' to red for those cells with negative values and green for those with
' positive ones. Empty or cells with zero in them are left untouched
'
Dim number_of_rows As Integer, i As Integer
Dim rantenetto As Double

Range("A65536").End(xlUp).Select
number_of_rows = ActiveCell.row

' Remove all colouring from column K
Range("K2:K" & number_of_rows).Select
With Selection.Interior
  .Pattern = xlNone
  .TintAndShade = 0
  .PatternTintAndShade = 0
End With

' Loop round setting all cells in column K to the correct colour
For i = 2 To number_of_rows
  rantenetto = Range("K" & i).Value
 ' If i = 342 Then
 '   rantenetto = Range("K" & i).Value
 ' End If
    
  Select Case True
    Case IsEmpty(rantenetto)
      ' empty - do nothing
    Case 0 = Round(rantenetto, 2)
      ' zero - again, do nothing
    Case Else
      Call colour_column_k(i, rantenetto)
  End Select

Next i

End Sub