View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
JE McGimpsey JE McGimpsey is offline
external usenet poster
 
Posts: 4,624
Default Help with my code and formula

Perhaps you can adapt this:

Public Function SumIfColor(critRange As Range, _
whatColor As Long, _
Optional sumRange As Range, _
Optional InteriorColor As Boolean = True) As Variant
Dim nSearchColor As Long
Dim i As Long
Dim dPartialSumRange As Range
Dim bValidCell As Boolean

SumIfColor = 0
If sumRange Is Nothing Then
Set sumRange = critRange
Else
With critRange
If (.Columns.Count < sumRange.Columns.Count) Or _
(.Rows.Count < sumRange.Rows.Count) Then GoTo Ref_Error
End With
End If
If whatColor <= 0 Then
nSearchColor = IIf(InteriorColor, xlColorIndexNone, _
xlColorIndexAutomatic)
If (whatColor < nSearchColor) And (whatColor < 0) Then _
GoTo Value_Error
Else
If whatColor 56 Then GoTo Value_Error
nSearchColor = whatColor
End If
For i = 1 To critRange.Count
If InteriorColor Then
bValidCell = critRange(i).Interior.ColorIndex = _
nSearchColor
Else
bValidCell = critRange(i).Font.ColorIndex = nSearchColor
Debug.Print bValidCell, critRange(i).Address, _
critRange(i).Font.ColorIndex
End If
If bValidCell Then
If dPartialSumRange Is Nothing Then
Set dPartialSumRange = sumRange(i)
Else
Set dPartialSumRange = _
Union(dPartialSumRange, sumRange(i))
End If
End If
Next i
If Not dPartialSumRange Is Nothing Then _
SumIfColor = Application.Sum(dPartialSumRange)
Exit Function
Ref_Error:
SumIfColor = CVErr(xlErrRef)
Exit Function
Value_Error:
SumIfColor = CVErr(xlErrValue)
End Function

Call as

SumIfColor($I$11:$I$22,43,B11:B22,TRUE)

In article ,
yh73090 wrote:

Here is the formula and it is not doing what I want and also is the code
for the "CellCol" in my formula.

=sumcellcol($I$11:$I$22,B11:B22)

What I need is for my formula to look at column "I" if the cell is
filled with color fill #43 then on the same row sum the amount in
column "B".

I also need to have the code checked.


Function SumCellCol(rng As Range, rng2 As Range) As Double
Dim Sumcell As Range
Dim dSum As Double
Application.Volatile True
dSum = 0
For Each Sumcell In rng2
If Sumcell.Interior.ColorIndex = 43 Then
dSum = dSum + Sumcell.Offset(0, -1).Value
End If
Next
SumCellCol = dSum
End Function