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

[bilbon]

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



[TABLE="width: 367"]
<colgroup><col span="3"><col><col><col></colgroup><tbody></tbody>[/TABLE]

[TABLE="width: 367"]
<colgroup><col span="3"><col><col><col></colgroup><tbody>[TR]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[TD]Min[/TD]
[TD]Max[/TD]
[TD]Colored cells[/TD]
[/TR]
[TR]
[TD]0,91[/TD]
[TD]0,97[/TD]
[TD]1,21[/TD]
[TD]0,36[/TD]
[TD]7,85[/TD]
[TD]0,98[/TD]
[/TR]
[TR]
[TD]1,18[/TD]
[TD]0,89[/TD]
[TD]1,00[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1,23[/TD]
[TD]1,00[/TD]
[TD]0,87[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]0,92[/TD]
[TD]0,91[/TD]
[TD]1,21[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]0,81[/TD]
[TD]1,24[/TD]
[TD]1,67[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]0,87[/TD]
[TD]1,13[/TD]
[TD]1,33[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]1,02[/TD]
[TD]0,87[/TD]
[TD]1,12[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]0,92[/TD]
[TD]1,11[/TD]
[TD]1,50[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

 

[DanteAmor]

Can you explain your example?

 

[bilbon]

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

 

[DanteAmor]

Try this, Your data should start in cell A1

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

 

[bilbon]

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

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.

 

[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

 

[DanteAmor]

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)

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.

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

 

[bilbon]

Hi DanteAmor


Thank you for your reply.
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

 

[DanteAmor]

Try:

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