Count rows by fill color and sum values

[thomasks]

I have several worksheets in a workbook, that have subtotals seperated by fill color (yellow or fillcolorindex =6). I need a procedure or function that will loop through the worksheet and find all of the fill colored rows and return the count of these rows, then for every 6 insert a row that will seperate them (no matter the total for these 6). Also I need to know the total sum of all of the fill rows per worksheet, and the total of how many seperated areas of 6 subtotals I have.
In other words each power panel can only have 6 branches per panel, and the branches are seperated by 20 amps or less. My code goes through the worksheet and counts up the amperage and when I have reached 20 ( or would go over 20 if I included the next row) it inserts the total amps for this series and highlights the row by fill color of yellow.
Now I need to know how many power panels are on each sheet, and the total amperage of each sheet.
Here is the code to count the amperage and insert the yellow line.

Public Sub cmdBranches_Click()
Dim R As Long, C As Long
Dim thisval As Variant
Dim MaxAllowed As Variant
Dim tot As Variant

Application.ScreenUpdating = False
If SheetHasRun = True Then
    Call FindFillRows
End If

If SheetHasRun = False And ActiveSheet.Name <> ("Formatted_Data") And ActiveSheet.Name <> ("ELM_Data") And ActiveSheet.Name <> _
    ("Totals") And ActiveSheet.Name <> ("Instructions for use") Then

MaxAllowed = 20
R = 3
C = 10
With ActiveSheet
    While .Cells(R, C) Or .Cells(R, 2) <> "" 'loop while the cell tested is not empty
        'get this row's value
        thisval = .Cells(R, C)
        
        'if over MaxAllowed, show sum
        If tot + thisval > MaxAllowed Or .Cells(R, 2) = "X" Then
        
            'insert a line above the current line
            If R > 3 Then
                .Rows(R).Select
                Selection.Insert Shift:=xlDown
                'Selection.Insert Shift:=xlDown
            End If
           
            'insert the total for this set
            .Cells(R, C) = tot
            Selection.Font.Bold = True
            With Selection.Interior
                .ColorIndex = 6
                .Pattern = xlSolid
            End With
                    
            'zero the total count
            tot = 0
            
            'move down to the start of the next set
            R = R + 1
        Else
            'we are below the required total so add this value
            tot = tot + thisval
            
        End If
        
        'shift the check point to the next row
        R = R + 1
    Wend
     .Rows(R).Select
    'insert the total for this set
            .Cells(R, C) = tot
    'Bold the totals
            Selection.Font.Bold = True
    'Highlight the rows with totals
        With Selection.Interior
            .ColorIndex = 6
            .Pattern = xlSolid
        End With
    'Delete rows from top of sheet that are blank
        'Rows("2:3").Select
        'Selection.Delete Shift:=xlUp
    .Range("b3").Select
End With
End If
Application.ScreenUpdating = True
SheetHasRun = True

End Sub

I also already have a function that finds all of the yellow rows:

Function FindFillRows()
Application.ScreenUpdating = False
On Error GoTo errhandler

If SheetHasRun = True And ActiveSheet.Name <> ("Formatted_Data") And ActiveSheet.Name <> ("ELM_Data") And ActiveSheet.Name <> _
    ("Totals") And ActiveSheet.Name <> ("Instructions for use") Then

R = 3
C = 10
'Loop through the worksheet finding the fill color rows.
With ActiveSheet
    While .Cells(R, C) <> "" 'loop while the cell tested is not empty
        With Application.FindFormat.Interior
            .Pattern = xlSolid
            .PatternColorIndex = xlAutomatic
            .ColorIndex = 6
        End With

    'Application.FindFormat.Locked = True
    'Application.FindFormat.FormulaHidden = False
    If SheetHasRun = True Then
    ActiveSheet.Cells.Find(What:="", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
        , SearchFormat:=True).Activate
    ' Select the entire row.
    Selection.EntireRow.Select
    ' Delete the row.
    Selection.Delete
    'Call the sub to delete the blank rows.
    
    End If
    R = R + 1
    Wend
    
End With


End If
errhandler:
Application.ScreenUpdating = True


DeleteBlankRows
End Function

Hopefully this post is not TOO rambling, but I could use some help coding this little assignment.
Thanks

 

[AnotherHiggins]

Just to get the ball rolling:
Is there logic behind which rows are yellow? If so, I think it would be easier to code for that logic instead of finding fill color.

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ181-2886 before posting.

 

[thomasks]

The only logic behind which rows are yellow is that this is showing the user where the code has inserted the subtotal for the amperage that was counted. The code runs down the column 10 and counts up to 20. Once it reaches 20 (without going over) it inserts a line, puts the total amps counted up in column 10 of the newly inserted row and fill colors it yellow and then continues on to the end of the worksheet.
This is reflected in the code posted under the sub called cmdbranches_click. Hope this helps to understand what is going on.

 

[SkipVought]

Hi,

Did you use the SUBTOTAL worksheet function or the SUBTOTAL feature in the Data menu? If so, you can use the SUBTOTAL function to SUM the entire range, using function number 9.

Skip,

_[red][/red]

 

[thomasks]

Actually no, as you can see in the code posted above I used the maxallowed to count up to 20 without going over, and then insert a line, put the total in, fill color it yellow and bold the font, and then continue on counting up till I hit the first blank row in the column that holds the amperages which is column 10.
A little explanation may help here. What I am doing is, we design conveyor systems. These systems have motors that are divided up into areas (like shipping, recieving, etc.) these areas are the seperate worksheets that get created when the user selects rows of motors off of the master sheet of equipment. Each area is then further divided by branches based on amperage (6 branches per power panel, and 20 amps per branch) I have the code already dividing the worksheet into 20 amp branches, and need to then assign every 6 branches to a power panel, show the count of power panels on each worksheet and show the total amperage for the area.

 

[SkipVought]

Have you considered using native the Excel functionality of SUBTOTAL?

I'd use the a [Sequence Nbr] & INT function to tag groups of 6. [GroupNbr] =INT([Sequence Nbr]/6)

Don't make it harder than it is. Chances are, it could ALL be done without VBA, and I'm a big VBA advocate.

Skip,

_[red][/red]

 

[thomasks]

I appreciate what you are saying Skip, but since I have no way of knowing how many motors are going to be on the worksheets, or where the breaks for the branches will have to go, how would I be able to place a formula on the worksheet. That is the reason I was doing it through VBA and letting the code place the totals, breaks, and formatting on the page where necessary.
Maybe I am not fully understanding what you have told me, I am pretty new at VBA and this workbook gets more complex as people use it and ask me to add more functionality to it.
They don't want to have to think or do any tasks that you would normally do on a spreadsheet, if they can get me to add it in automatically

 

[SkipVought]

The SUBTOTAL feature (not function) puts those breaks in for you, if you have the table sorted and grouped properly; hence a column using the INT function for grouping of 6.

Skip,

_[red][/red]