VBA Function to count cells without background color

[morales7_0]

I found this code online but didn't quite work out after a few modifications. What I'm trying to do is compare two ranges. First range contains text in the cells and the second range contains cells with background/filled color. What I'm trying to do is only count the number of cells that do not have a background/fill color in the second range and that match specific text in the first range.

For example:

Range 1 Range 2
CDQ
CDQ (Filled red)
CDI
CDI
CDI (Filled red)
CDI
WK
WK
Wk

Result should display the following on another range of cells like this:

CDQ = 1
CDI = 3
WK = 3


Any help with is greatly appreciated. Thanks!

Function ColorFunction(rColor As Range, rQual As Range)
Dim rCell As Range
Dim rCell2 As Range
Dim vResult


For Each rCell In rColor
For Each rCell2 In rQual
If rCell.Interior.ColorIndex <> xlNone And rCell2.Value = "CDQ" Then
vResult = 1 + vResult
End If
Next rCell2
Next rCell


ColorFunction = vResult


End Function

 

[bellman101]

The If statement is saying <> xlNone. Try changing this to = xlNone...

Cheers
JB

 

[morales7_0]

Thank you! I'll try that and see what happens.

 

[bellman101]

Looking at it some more, I don't think that's your only issue. I think there should only be 1 loop. As you have a loop nested inside another, you are looping through every rCell2 for each rCell. For example if rColor is A2:A11 and rQual is B2:B11, on the first rCell loop, it will look at Cell A2. It then gets into the rCell2 loop, so while still looking at A2, it will then look at B2, B3, etc. IT's tough to explain but hopefully you get what I mean.

Instead I believe you need a single loop, on one set of cells, and then in each loop also look at the corresponding cell from the other range. Something like this:

For Each rCell2 In rQual
    Set rCell = rCell2.Offset(0, 1)
    If rCell.Interior.ColorIndex = xlNone And rCell2.Value = "CDQ" Then
    vResult = 1 + vResult
    End If
Next rCell2
[COLOR=#333333]

[/COLOR]
This assumes that rColor is in the column immediately next to rQual. If not, adjust the '1' in the Offset() accordingly.

You're only feeding in one range now - rQual, so adjust the function line:

Function ColorFunction(rQual As Range)

Finally, to reflect this last change, adjust the formula in the worksheet to only contain your rQual range, so =ColorFunction(A2:A11) for example.

Don't think I've missed anthing, so hopefully that will get you over the line. Let me know if this isn't clear and I'll do my best to clarify.

Cheers
JB

 

[Fluff]

@morales7_0
I suspect that the problem lies in the order your sending ranges to to the function.
From your description you are sending rQual as range1 & rColor as range2, but the function is expecting them the other way round.

 

[bellman101]

Very possible, not possible to know without seeing the worksheet formula though.

But as long as the text range is on the left, colour on the right, and the TEXT range is fed into the formula, the above code should work nicely.

 

[morales7_0]

bellman01,

I see what you were saying about the nesting loops. Your adjustments work! The only thing I'm trying to figure out now is how to change this line of code to conform to changing the range of filled cells. Range 1 that contains the text remains constant; however, the range of the color filled cells will change as it increases to the right. I wish I could post the Excel file for you to see. It is pretty much a monthly personnel tracker. The first column contains the name of the person and the second column contains their qualification. The third column starts with the first day of the month and the following columns continue across to the last day of the month. Above each column of each day of the month it has the numbers of qualified personnel available for that day as calculate by the none color filled cells.

Set rCell = rCell2.Offset(0, 1)

 

[bellman101]

Hi morales,

Glad it works for you. the offset works like this:

cell1 = cell2.offset(rows,cols)

So if cell2 is using column B, and you want the corresponding value from column D, then it would be Set rCell = rCell2.Offset(0,2) (0 rows down and 2 columns across).

Will this suffice, or are you saying you need to check more than one column for colour in each loop?

Cheers
JB