PDA

View Full Version : [SOLVED] UDF to count colored cell pairs fails with #VALUE!



BobR
05-18-2018, 10:22 AM
I have a spreadsheet with colored cells, Red/Yellow/Green, and found UDFs GetCellColor() and CountCellsByColor() that worked as expected. However, as I wanted to count the instances of two same colored cells, I created myCountCellsByColor() by using CountCellsByColor() as a model.

Unfortunately, when I use =myCountCellsByColor($b$2:$b$11,getcellcolor($e$2),$c$2:$c$11,getcellcolor( $e$2)) it fails with #VALUE!.

Not sure where I went wrong and was unable to find anything in my searches so am hoping someone can identify my mistake.

Thanks in advance.

The UDFs are:

Function GetCellColor(xlRange As Range)
Dim indRow, indColumn As Long
Dim arResults()

Application.Volatile

If xlRange Is Nothing Then
Set xlRange = Application.ThisCell
End If

If xlRange.Count > 1 Then
ReDim arResults(1 To xlRange.Rows.Count, 1 To xlRange.Columns.Count)
For indRow = 1 To xlRange.Rows.Count
For indColumn = 1 To xlRange.Columns.Count
arResults(indRow, indColumn) = xlRange(indRow, indColumn).Interior.Color
Next
Next
GetCellColor = arResults
Else
GetCellColor = xlRange.Interior.Color
End If
End Function



****************


Function CountCellsByColor(rData As Range, cellRefcolor As Range) As Long
Dim indRefColor As Long
Dim cellCurrent As Range
Dim cntRes As Long

Application.Volatile

cntRes = 0
indRefColor = cellRefcolor.Cells(1, 1).Interior.Color
For Each cellCurrent In rData
If indRefColor = cellCurrent.Interior.Color Then
cntRes = cntRes + 1
End If
Next cellCurrent

CountCellsByColor = cntRes
End Function

**************



Function myCountCellsByColor(rData As Range, cellRefColor1 As Range, sData As Range, cellRefColor2 As Range) As Long

Dim indRefColor1, indRefColor2, cntRes As Long
Dim cellCurrent1, cellCurrent2 As Range
Dim i, lastRow As Integer

Application.Volatile

lastRow = rData.Rows.Count
Debug.Print lastRow

cntRes = 0

indRefColor1 = cellRefColor1.Cells(1, 1).Interior.Color
indRefColor2 = cellRefColor2.Cells(1, 1).Interior.Color

For i = 1 To lastRow
If indRefColor1 = cellCurrent1.Interior.Color(i, 1) Then
If indRefColor2 = cellCurrent2.Interior.Color(i, 1) Then
cntRes = cntRes + 1
End If
End If
Next i

myCountCellsByColor = cntRes
End Function

offthelip
05-18-2018, 11:36 AM
I think your problem is because the input to mycountcellsbycolour is 4 ranges, while the output of the function getcolour is unspecified which I think you will find will be a variant.

Paul_Hossler
05-18-2018, 07:26 PM
1. I added CODE tags to your original post - you can use the [#] icon to insert then and paste macros between

2. I think it best to always explicitly state the return value of a function, in "Dm indRow, indColumn As Long" the indRow is a Variant (in VBA you have to be specific -- As Long), and you don't need the .Volatile

3. ADDED: Since these are on a Worksheet, I'd use .ColorIndex instead




Function GetCellColor(xlRange As Range) As Variant
Dim indRow As Long, indColumn As Long
Dim arResults() As Long
Application.Volatile





3. I think this is what you want, but it might get you farther along

22277




Function myCountCellsByColor(rData1 As Range, rData2 As Range, cellRefColor As Range) As Long
Dim indRefColor As Long, cntRes As Long
Dim cellCurrent As Range

indRefColor = cellRefColor.Cells(1, 1).Interior.Color
cntRes = 0

For Each cellCurrent In rData1.Cells
If cellCurrent.Interior.Color = indRefColor And _
rData2.Cells(cellCurrent.Row, 1).Interior.Color = indRefColor Then
cntRes = cntRes + 1
End If
Next

myCountCellsByColor = cntRes
End Function

BobR
05-19-2018, 05:48 AM
Paul,

Thanks for this help. I cleaned up the variant issues and attempted your "For Each" logic though, for some reason, it did not provide the same results as in your example. That said, when reverting back to my "For i to lastRow" I got exactly what was expected. Also, I kept the four input parameters so this function can count both similar and dissimilar colored cell pairs, depending on need.


#Function myCountCellsByColor(rData1 As Range, cellRefColor1 As Range, rData2 As Range, cellRefColor2 As Range) As Long

Dim indRefColor1 As Long, indRefColor2 As Long, cntRes As Long
Dim cellCurrent As Range, cellCurrent1 As Range, cellCurrent2 As Range
Dim i As Integer, lastRow As Integer

Application.Volatile

lastRow = rData1.Rows.Count

cntRes = 0

indRefColor1 = cellRefColor1.Cells(1, 1).Interior.Color
indRefColor2 = cellRefColor2.Cells(1, 1).Interior.Color

For i = 1 To lastRow
If indRefColor1 = rData1(i, 1).Interior.Color Then
If indRefColor2 = rData2(i, 1).Interior.Color Then
cntRes = cntRes + 1
End If
End If
Next i

myCountCellsByColor = cntRes
End Function

Thanks again

BobR