How to modify custom function. Help

N

nanrem

New member
Joined
Sep 22, 2014
Messages
6
Reaction score
0
Points
0
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:
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
 
I suggest instead of for each rCell in rRange you should loop rows and columns
(untested code below, may be minor typos)

for iRow = 1 to ubound(lCol,1)
for jCol = 1 to ubound(lcol,1)
for k = jCol+1 to ubound(lcol,1) -1
if lCol(iRow,k) = lcol(iRow,jCol) then lCol(iRow,k) = -1 'flag as already counted
next k
next jCol
next iRow

Then can continue as normal or include code in upper loop to add
 
WizzardOfOz said:
I suggest instead of for each rCell in rRange you should loop rows and columns
(untested code below, may be minor typos)

for iRow = 1 to ubound(lCol,1)
for jCol = 1 to ubound(lcol,1)
for k = jCol+1 to ubound(lcol,1) -1
if lCol(iRow,k) = lcol(iRow,jCol) then lCol(iRow,k) = -1 'flag as already counted
next k
next jCol
next iRow

Then can continue as normal or include code in upper loop to add
Click to expand...

Hi wizzardOfOz:
Thanks for the reply, i really didn't get it, but a friend on a forum helped with the function and ended with this code
Code: 
[COLOR=blue]Function[/COLOR][COLOR=#333333] ColorFunction(rColor [/COLOR][COLOR=blue]As[/COLOR][COLOR=#333333] Range, rRange [/COLOR][COLOR=blue]As[/COLOR][COLOR=#333333] Range, Optional SUM [/COLOR][COLOR=blue]As[/COLOR][COLOR=#333333] [/COLOR][COLOR=blue]Boolean[/COLOR][COLOR=#333333]) [/COLOR]
    [COLOR=blue]Dim[/COLOR] i [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR], ii [COLOR=blue]As[/COLOR] [COLOR=blue]Long[/COLOR]     [COLOR=blue]For[/COLOR] i = 1 [COLOR=blue]To[/COLOR] rRange.Rows.Count         [COLOR=blue]For[/COLOR] ii = 1 [COLOR=blue]To[/COLOR] rRange.Columns.Count             [COLOR=blue]If[/COLOR] rRange(i, ii).Interior.ColorIndex = rColor.Interior.ColorIndex [COLOR=blue]Then[/COLOR]                 ColorFunction = ColorFunction + IIf(SUM, Val(rRange(i, ii).Value), 1)                 Exit [COLOR=blue]For[/COLOR]             [COLOR=blue]End[/COLOR] [COLOR=blue]If[/COLOR]         [COLOR=blue]Next[/COLOR]     [COLOR=blue]Next[/COLOR]  [COLOR=blue]End Function[/COLOR][COLOR=#333333]
[/COLOR]I share it and hope it help someone else. I know there are a lot of people out there with similar situations. Thanks a lot WizardOfOz, i really appreciate your help bro. Have a nice day :D
 
You must log in or register to reply here.
Back
Top