# Product sum for min, max and the colored cells in VBA

#### bilbon

##### Board Regular
Hi
Someone who can help me figure out the product sum for min, max and the colored cells in A2:C9.
The coloured cells have a colour index of 15 and 40.
Preferably VBA code

/Bilbon

<colgroup><col span="3"><col><col><col></colgroup><tbody></tbody>

 A B C Min Max Colored cells 0,91 0,97 1,21 0,36 7,85 0,98 1,18 0,89 1,00 1,23 1,00 0,87 0,92 0,91 1,21 0,81 1,24 1,67 0,87 1,13 1,33 1,02 0,87 1,12 0,92 1,11 1,50

<colgroup><col span="3"><col><col><col></colgroup><tbody>
</tbody>

### Excel Facts

Return population for a City
If you have a list of cities in A2:A100, use Data, Geography. Then =A2.Population and copy down.
Can you explain your example?

Hi DanteAmor

I calculate the numbers every day and the coloured cells are different every day.
It is the cell that has a fill color.

Min is the smallest numbers on each line * each other
0.91 * 0.89 * 0.87 * 0.91 * 0,81 * 0.87 * 0.87 * 0,92

Max is the largest numbers on each line * each other.
1.21 * 1.18 * 1.23 * 1.21 * 1,67 * 1.33 * 1.12 * 1.50

Colored cells are the colored cells on each row * each other.
0,97 * 0.89 * 0.87 * 0,92 * 1.24 * 1.13 * 1.12 * 0,92

/Bilbon

Try this, Your data should start in cell A1

Code:
``````Sub Product_Sum()

u = Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To u
wMin = WorksheetFunction.Min(Range("A" & i).Resize(1, 3))
wMax = WorksheetFunction.Max(Range("A" & i).Resize(1, 3))
If pMin = 0 Then pMin = wMin Else pMin = pMin * wMin
If pMax = 0 Then pMax = wMax Else pMax = pMax * wMax

For j = 1 To 3
If Cells(i, j).Interior.ColorIndex = 15 Or Cells(i, j).Interior.ColorIndex = 40 Then
If pCol = 0 Then pCol = Cells(i, j).Value Else pCol = pCol * Cells(i, j).Value
End If
Next
Next

Range("D2").Value = pMin
Range("E2").Value = pMax
Range("F2").Value = pCol

End Sub``````

Hi DanteAmor

The code works perfectly. Will save a lot of time for me.
I am very grateful for your help.Thank you very much.

/Bilbon

Hi

Would it be possible to make DanteAmors code to 3 UDF?
1 for MIN and 1 for MAX and 1 for COLORED CELLS.
Anyone have that knowledge?
I have seen that they would be even more helpful.

/Bilbon

Go the 3 udf.

You put the udf and the range, e.g .:

=udf_Min(A1:C8)
=udf_Max(A1:C8)
=udf_colored_cells(A1:C8)

Code:
``````Function [B]udf_Min[/B](rng As Range)

u = rng.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To u
wMin = WorksheetFunction.Min(rng.Cells(i, 1).Resize(1, 3))
If pMin = 0 Then pMin = wMin Else pMin = pMin * wMin
Next
udf_Min = pMin

End Function

Function [B]udf_Max[/B](rng As Range)

u = rng.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To u
wMax = WorksheetFunction.Max(rng.Cells(i, 1).Resize(1, 3))
If pMax = 0 Then pMax = wMax Else pMax = pMax * wMax
Next
udf_Max = pMax

End Function

Function [B]udf_colored_cells[/B](rng As Range)

u = rng.Cells(Rows.Count, 1).End(xlUp).Row
For i = 1 To u

For j = 1 To rng.Cells(1, Columns.Count).End(xlToLeft).Column
If rng.Cells(i, j).Interior.ColorIndex = 15 Or rng.Cells(i, j).Interior.ColorIndex = 40 Then
If pCol = 0 Then pCol = rng.Cells(i, j).Value Else pCol = pCol * rng.Cells(i, j).Value
End If
Next
Next
udf_colored_cells = pCol

End Function``````

Additionally, put the following code in the events of your sheet; As the color udf is not activated if you put the color manually, then to update the result of the color udf, you will have to select any cell.

Code:
``````Private Sub [B]Worksheet_SelectionChange[/B](ByVal Target As Range)
Calculate
End Sub``````

Hi DanteAmor

Must the data I should figure out be in A1: C8?
Works well with the data in A1: C8 but tried to move the data to A11: C19 then I get #VALUE ! Error.

/Bilbon

Try:

Code:
``````Function udf_Min(rng As Range)

[COLOR=#0000ff]    u = rng.Rows.Count[/COLOR]
For i = 1 To u
wMin = WorksheetFunction.Min(rng.Cells(i, 1).Resize(1, 3))
If pMin = 0 Then pMin = wMin Else pMin = pMin * wMin
Next
udf_Min = pMin

End Function

Function udf_Max(rng As Range)

[COLOR=#0000ff]    u = rng.Rows.Count[/COLOR]
For i = 1 To u
wMax = WorksheetFunction.Max(rng.Cells(i, 1).Resize(1, 3))
If pMax = 0 Then pMax = wMax Else pMax = pMax * wMax
Next
udf_Max = pMax

End Function

Function udf_colored_cells(rng As Range)
[COLOR=#0000ff]    u = rng.Rows.Count[/COLOR]
For i = 1 To u

For j = 1 To rng.Cells(1, Columns.Count).End(xlToLeft).Column
If rng.Cells(i, j).Interior.ColorIndex = 15 Or rng.Cells(i, j).Interior.ColorIndex = 40 Then
If pCol = 0 Then pCol = rng.Cells(i, j).Value Else pCol = pCol * rng.Cells(i, j).Value
End If
Next
Next
udf_colored_cells = pCol

End Function``````

Replies
2
Views
3K
Replies
11
Views
2K
Replies
4
Views
586
Replies
2
Views
611
Replies
0
Views
463

1,219,828
Messages
6,150,470
Members
450,966
Latest member
Yali

### We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

### Which adblocker are you using?

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

### Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

### Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

### Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back