How to subtotal by color in a column

Question

Here is some code I've adapted from a previous post on counting items by color in a column.  Now I need to sum the numbers by displayed color by picking a range to sum with the mouse using an input box, picking a cell below the column to put the subtotal, then selecting one cell above of any color and display it in its color in the subtotal. I may have only three or four different colors in a column of numbers that I want to subtotal below to perform more math on.  It would be nice if it could work on interior colors or font colors. I would normally use the standard colors, but I should work on any color by selecting one of the colors above.  I've got the input boxes for the three selections but I need to adapt this code from my previous post on "counting font colors in a column to obtain the number of items of that color" post. Not sure if it can be a one dimensional array or more.  Don't care about the colorindex. I'm not sure of the Type parameter for default on the 3rd InputBox. The code gives an error on the size of the array.

Sub SumCellsByColor()

Dim bFlag As Boolean        'Use to sum by font colors in a column
Dim i As Integer
Dim TotClrs As Long, clr As Long
Dim ClrSum As Integer
Dim rng As Range, cel As Range
Dim rngResults As Range
Dim UserRange As Range
Dim CurrCell As Range
Dim OneColorToSum As Variant
                
    On Error GoTo Canceled
   
    Set UserRange = Application.InputBox _
                    (Prompt:="Use the mouse to select a range to sum by color:", _
                      Title:="Sum cells by Font ColorIndex Range Selection", _
                      Default:=Selection.Address, Type:=8)
                      'Range Selection to sum with one color

    Set rngResults = Application.InputBox _
                     (Prompt:="Use the mouse to select a range to place the sum total:", _
                       Title:="Sum Placement on the worksheet", _
                       Default:=Selection.Address, Type:=8)
                       'Range Selection to put the sum total
                      
    Set OneColorToSum = Application.InputBox _
                     (Prompt:="Use the mouse to select a number of a color to sum for this column:", _
                       Title:="Color Selection to sum on the worksheet", _
                       Default:=Selection.Address, Type:=8)   
                       'Pick one of the different colors to sum
                       
        For Each cel In rng
        If Len(cel.Value) > 0 Then   'ADD IF CHECK HERE to count only nonblank cells
             clr = cel.Font.Color
             bFlag = True
            
        End If
        Next
    Application.EnableEvents = False
   
     ReDim arr(0 To 1)    'results of the sum of each item by color
        For i = 1 To ClrSum
       
             rngResults.Cells(i, 1).Value = arr(0, i)         'color value by its index
             rngResults.Cells(i, 1).Font.Color = arr(0, i)    'index color displayed in its own color
             rngResults.Cells(i, 2).Value = arr(1, i)         'total count of one color

    ReDim Preserve arr(0 To 1, 1 To TotClrs)    'results of the count of each item by color
        For i = 1 To TotClrs
             rngResults.Cells(i, 1).Value = arr(0, i)
             rngResults.Cells(i, 1).Font.Color = arr(0, i)
             rngResults.Cells(i, 2).Value = arr(1, i)
Next

Canceled:
    Application.EnableEvents = True

 

End Sub

What is the correct parameter for the OneColorTo Sum Type?  Everything below the last IB statement is from the previous post.

Thanks in Advance once again.

---

Roliver

Answer 1

If I have understood what you wish to do, then your code should be amended to this;

Sub SumCellsByColor()
 
 Dim clr As Long
 Dim ClrSum As Double
 Dim cel As Range
 Dim rngResults As Range
 Dim UserRange As Range
 Dim OneColorToSum As Range
                     
  Set UserRange = Application.InputBox _
                   (Prompt:="Use the mouse to select a range to sum by color:", _
                     Title:="Sum cells by Font ColorIndex Range Selection", _
                     Default:=Selection.Address, Type:=8)
                     'Range Selection to sum with one color
  
  Set rngResults = Application.InputBox _
                    (Prompt:="Use the mouse to select a range to place the sum total:", _
                      Title:="Sum Placement on the worksheet", _
                      Default:=Selection.Address, Type:=8)
                      'Range Selection to put the sum total
                      
  Set OneColorToSum = Application.InputBox _
                    (Prompt:="Use the mouse to select a color to sum for this column:", _
                      Title:="Color Selection to sum on the worksheet", _
                      Default:=Selection.Address, Type:=8)
                     'Pick one of the different colors to sum

  Application.EnableEvents = False

' set clr to the colour of the font of the selected cell OneColorToSum
  clr = OneColorToSum.Font.Color
  ClrSum = 0

  For Each cel In UserRange
    If Len(cel.Value) > 0 Then   'ADD IF CHECK HERE to count only nonblank cells
      If cel.Font.Color = clr Then
        ClrSum = ClrSum + cel.Value
      End If
    End If
  Next

  rngResults.Value = ClrSum

  Application.EnableEvents = True
End Sub

However, it seems easier to me to use a function to get the sum of cells with a certain font colour. Like this;

Function SumRangeByColor(RangeToSum As Range, CellWithFontColorToSum As Range) As Double
Dim ClrSum As Double
Dim cell As Range

  Application.EnableEvents = False

  ClrSum = 0

  For Each cell In RangeToSum
    If Len(cell.Value) > 0 Then
      If cell.Font.Color = CellWithFontColorToSum.Font.Color Then
        ClrSum = ClrSum + cell.Value
      End If
    End If
  Next

  SumRangeByColor = ClrSum

  Application.EnableEvents = True
End Function

You use the function in a workbook cell. For instance if the range you wish to sum is D4:D9 and cell D13 is formatted with the font colour you wish to sum, then you can add the formula

=SumRangeByColor(D4:D9,D13) in a worksheet cell (even in cell D13) to get the result.

---

Ed Ferrero
www.edferrero.com

Answer 2

Ok Ed, the first part works great. Now, I'd like it to work the same manner regardless of the text color if the text font is black but the interior cell color is something other than white.  Can this be done easily in the same sub?

The function option I don't quite get as I get the #NAME error when I paste it into the cell.  Shouldn't it appear in the dropdown list of functions once I start typing it? I psted the code into the same module as above in my Personal.xlsb. Is that not correct?

Thanks again. 

---

Roliver

Answer 3

If you add a function to your personal workbook, you need to reference that workbook. i.e. the function enterd in a cell would look like this;

=Personal.xlsb!SumRangeByColor(...

It is IMO better to put User Defined Functions in an xlam - this saves the functions as an Add-In that you can load and use in any workbook.

If you want to sum by interior colour, you need to change the line

If cell.Font.Color = CellWithFontColorToSum.Font.Color Then

to

If cell.Interior.Color = CellWithFontColorToSum.Interior.Color Then

---

Ed Ferrero
www.edferrero.com