How to modify custom Function

[nanrem]

Hi all:

I have a custom function that count a range of cells by a specific color that works great, but i need to modify it, so it doesn't count more than one cell in a row. This is the code:

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 SUM = True Then
For Each rCell In rRange
If rCell.Interior.ColorIndex = lCol Then
vResult = WorksheetFunction.SUM(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

And this is the formula: "=colorfunction(A362,AP357:AV360,FALSE)"
were the first cell 'A362' is used as color reference.

For example, using the formula as reference, we will use cell 'A362' that is RED, to count from 'AP357:AV360', that means we have 7 columns and 4 rows, and we have 'AP357, AT357, AQ358 and AV360' marked with RED. So the new Formula should count only 3, because there are 2 marked cells in a same row. I have been trying this for weeks without results. Any help out there will be appreciated. Thanks

 

[prasaddn]

Hi,

I have used one line of code to skip the cells of range from same row.

check this code:

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
Dim iCurrRow As Integer
iCurrRow = 0
If SUM = True Then
For Each rCell In rRange
  If Not iCurrRow = rCell.Row Then
  If rCell.Interior.ColorIndex = lCol Then
  vResult = WorksheetFunction.SUM(rCell, vResult)
  End If
  End If
  iCurrRow = rCell.Row
Next rCell
Else
For Each rCell In rRange
  If Not iCurrRow = rCell.Row Then
  If rCell.Interior.ColorIndex = lCol Then
  vResult = 1 + vResult
  End If
  End If
  iCurrRow = rCell.Row
Next rCell
End If
ColorFunction = vResult
End Function

Regards,
Prasad DN

 

[nanrem]

Hi Prasad;

Thanks for the reply, try the code, but the count stays on 0. A friend on a forum helped with the case and we ended with this code.

Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As Boolean)
Dim i As Long, ii As Long
For i = 1 To rRange.Rows.Count
For ii = 1 To rRange.Columns.Count
If rRange(i, ii).Interior.ColorIndex = rColor.Interior.ColorIndex Then
ColorFunction = ColorFunction + IIf(SUM, Val(rRange(i, ii).Value), 1)
Exit For
End If
Next
Next
End Function

I shared it and i hope it helps to others excel users around. Thanks for everything. Have a nice day