ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Worksheet Functions (https://www.excelbanter.com/excel-worksheet-functions/)
-   -   SumProduct by cell color (https://www.excelbanter.com/excel-worksheet-functions/211454-sumproduct-cell-color.html)

brownti

SumProduct by cell color
 
I have the following code to sum cells by cell color, however i need to take
it one step further by using sum product by cell color. i would like to sum
the numbers in the colored cells and then multiply by other cells that dont
have to have a specific color. can someone please help me out? Thanks
Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As
Boolean)
Dim rCell As Range
Dim lCol As Long
Dim vResult

''''''''''''''''''''''''''''''''''''''
'Written by Ozgrid Business Applications
'www.ozgrid.com
'Sums or counts cells based on a specified fill color.
'''''''''''''''''''''''''''''''''''''''
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

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...tions/200811/1


Sheeloo[_3_]

SumProduct by cell color
 
Introduce a parameter OFFSET
multiply each cell with the cell at that offset and then SUM

If you want it to work on Rows and Column both then add DIRECTION also and
calculate offset beased on that parameter...

"brownti" wrote:

I have the following code to sum cells by cell color, however i need to take
it one step further by using sum product by cell color. i would like to sum
the numbers in the colored cells and then multiply by other cells that dont
have to have a specific color. can someone please help me out? Thanks
Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As
Boolean)
Dim rCell As Range
Dim lCol As Long
Dim vResult

''''''''''''''''''''''''''''''''''''''
'Written by Ozgrid Business Applications
'www.ozgrid.com
'Sums or counts cells based on a specified fill color.
'''''''''''''''''''''''''''''''''''''''
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

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...tions/200811/1



Shane Devenshire[_2_]

SumProduct by cell color
 
Hi,

Here is code that basically does the same thing

Function CountFormats(R As Range, E As Range) As Integer
Dim cell As Range
Dim Total As Integer
Dim T As Boolean
Set S = E.Cells(1, 1)
Total = 0
For Each cell In R
T = True
With cell
If .Interior.ColorIndex < S.Interior.ColorIndex Then T = False
End With
If T = True Then
Total = Total + 1 * Cells(cell.Row, 12)
End If
Next cell
CountFormats = Total
End Function

The key line relative to your question is Total = Total +1*Cells(cell.Row,12)

If this helps, please click the Yes button

Cheers,
Shane Devenshire

"brownti" wrote:

I have the following code to sum cells by cell color, however i need to take
it one step further by using sum product by cell color. i would like to sum
the numbers in the colored cells and then multiply by other cells that dont
have to have a specific color. can someone please help me out? Thanks
Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As
Boolean)
Dim rCell As Range
Dim lCol As Long
Dim vResult

''''''''''''''''''''''''''''''''''''''
'Written by Ozgrid Business Applications
'www.ozgrid.com
'Sums or counts cells based on a specified fill color.
'''''''''''''''''''''''''''''''''''''''
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

--
Message posted via OfficeKB.com
http://www.officekb.com/Uwe/Forums.a...tions/200811/1




All times are GMT +1. The time now is 06:43 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com