Excel VBA modification

Question

I have the following VBA code for a function that counts or sums cells if they have a specific background fill colour, given by a reference cell:

Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As Boolean)

Dim rCell As Range
Dim lCol As Long
Dim vResult

lCol = rColor.Interior.ColorIndex

    If Count = True Then
       For Each rCell In rRange
          If rCell.Interior.ColorIndex = lCol Then
              vResult = WorksheetFunction.Count(rCell) + vResult
          End If
       Next rCell
    Else
       For Each rCell In rRange
          If rCell.Interior.ColorIndex = lCol Then
              vResult = 1 + vResult
          End If
       Next rCell
    End If

ColorFunction = vResult

End Function

As I am unfamiliar with the VBA environment, how do I modify this code to accept 2 cells as "baselines" for background fill colour and output the count/sum of a range if a row of cells contains both of the two input colours?

Where is Count set? are you wanting to look at background and Foreground colors, or do you mean if either of the cells are a specific color? If you want to look at additive colors, then do we simply add the values to each other (RGB), or are you operating on primary colors only? — SeanC
@SeanCheshire I mean I would like to modify the function to accept two "input" colours and one sum/count range. That is to say, for example, if I had two input cells A1 and B1, and my sum/count range from cells C1:D20, if only cells C10 and D10 had the colours specified in A1 and B1, the count would return 1 (i.e. it checks row by row). I'm not looking to add the colours together, just count the cells or sum the contents based on the background fill colour. — Gokotai
I assume Count should be SUM. If you are unfamiliar with the VBA environment you are unlikely to understand an answer if one was posted. Search the web for "Excel VBA Tutorial" of visit a good library and check their Excel VBA Primers. The time you spend learning VBA will quickly repay itself. — Tony Dallimore
@TonyDallimore I appreciate the sentiment but I can code in C++ and Python, just not VB. I have the capacity to understand it, but I'm not certain about the syntax etc. Also, this code was copied straight from another forum... — Gokotai
Apart from showing how to access the interior colour index, I think the posted code will be of little value in creating the function you seek. The current function loops over a range by cell. You want to split rRange into rows and then cells within each row. The syntax of VBA is a minor problem. Understanding the Excel Object Model is the big problem for you. — Tony Dallimore

SeanC SeanC · Accepted Answer · 2014-05-20T13:21:46

First thing to learn about VBA is unless you specify, it doesn't require variable declaration - any new variable referenced is automatically created as an uninitialized variant. This is useful for quick programming, but useless for anything more than toy programming.

Always put in Option Explicit as the first line in your modules, and it will throw an error when you use initialied=0 instead of initialized=0, instead of creating a new variable, and making it very difficult to debug...

I would also use CamelCase when defining variables, and keep typing in lower case - vba will capitalize as appropriate, so if you do type a variable wrong, it will not change to have upper case letters when you complete the line

Dim TestIt
testit = 1 'will change to TestIt = 1
testti = 1 'will not have upper case letters

That rant over, lets take a look at the program.

First thing we need to do is to check that you are actually giving 2 cells for the colors. This can be done by checking the cell count:

If rColor.Cells.Count <> 2 Then
    ...

next is to check we have at least 2 columns to check

If rRange.Columns.Count = 1 Then
    ....

finally we have to change the logic of the total/sum. Currently, it checks each cell individually, and there is no way to see if another color has been found on the same row, so we have to change that to check each row individually. This is most easily done by 2 nested For ... Next loops

Once we have done checking a row, then we need to check if both colors have been found. We can define a couple of flags to test that.

If rRange.Cells(LoopCols, LoopRows).Interior.ColorIndex = Color1 Then
    Find1stColor = True

and same for the 2nd color, and check at the end of the row with

If Find1stColor And Find2ndColor Then

Once we have that structure defined, we can then write our program:

Option Explicit

Function Color2Function(rColor As Range, rRange As Range, Optional SUM As Boolean)

Dim RowCount As Long
Dim ColCount As Long
Dim tempResult
Dim Color1 As Long
Dim Color2 As Long
Dim Totals
Dim LoopRows As Long
Dim LoopCols As Long
Dim Find1stColor As Boolean
Dim Find2ndColor As Boolean

If rColor.Cells.Count <> 2 Then
    Color2Function = CVErr(xlErrRef) 'Error 2023 returns #REF!
    Exit Function
End If

Color1 = rColor.Cells(1).Interior.ColorIndex
Color2 = rColor.Cells(2).Interior.ColorIndex

RowCount = rRange.Rows.Count
ColCount = rRange.Columns.Count

If ColCount = 1 Then
    Color2Function = 0 ' one column can never contain 2 colors
    Exit Function
End If

For LoopRows = 1 To RowCount
    Find1stColor = False
    Find2ndColor = False
    tempResult = 0
    For LoopCols = 1 To ColCount
        If rRange.Cells(LoopCols, LoopRows).Interior.ColorIndex = Color1 Then
            Find1stColor = True
            tempResult = tempResult + rRange.Cells(LoopCols, LoopRows).Value
        End If
        If rRange.Cells(LoopCols, LoopRows).Interior.ColorIndex = Color1 Then
            Find2ndColor = True
            tempResult = tempResult + rRange.Cells(LoopCols, LoopRows).Value
        End If
    Next
    If Find1stColor And Find2ndColor Then
        If SUM Then
            Totals = Totals + tempResult
        Else
            Totals = Totals + 1
        End If
    End If
Next

Color2Function = Totals

End Function

I leave it as an exercise for yourself to decide what to do if one of the colors is found more than once.

Excel VBA modification

1 Answers