Calculation based on cell colors row for row

Question

This code does the calculation based on the cell color "green". Unfortunately, when it gets to the next row e.g. row "E" (as in the figure) the calculation is not done separately e.g. only for row C but it takes the values in row C as seen in the figure. How can I rewrite the code in such a way that the calculation is done a row for row only?

Sub Schaltfläche1_Klicken()
Dim wb As Workbook, wq As Object
Dim ws As Worksheet, datDatum
Dim cell As Range
Dim c As Long, r As Long, rng As Range

With Worksheets("Tabelle1")

For c = 3 To 5
    For r = 1 To 5
        If .Cells(r, c).DisplayFormat.Interior.Color = vbRed Then
            If rng Is Nothing Then
                Set rng = .Cells(r, c)
            Else
                Set rng = Union(rng, .Cells(r, c))
            End If
        End If
    Next r

 If Not rng Is Nothing Then _
        .Cells(8, c).Formula = "=average(" & rng.Address(0, 0) & ")"  
Next c
End With
End Sub

Answer 1

Not quite sure, if I get you correctly, but what I understood is: Calculate the average of cells with criteria in a single row. Therefore you have one average in row 1, one in row 2 ...

This would be my approach (quickly scetched upon yours):

Sub Schaltfläche1_Klicken()
Dim wb As Workbook, wq As Object
Dim ws As Worksheet, datDatum
Dim cell As Range
Dim c As Long, r As Long, rng As Range

With Worksheets("Sheet1")

For c = 3 To 5
    For r = 1 To 5
        If .Cells(r, c).DisplayFormat.Interior.Color = vbRed Then
            If rng Is Nothing Then
                Set rng = .Cells(r, c)
            Else
                Set rng = Union(rng, .Cells(r, c))
            End If
        End If
        If Not rng Is Nothing Then _
        .Cells(8, c).formula = "=average(" & rng.Address(0, 0) & ")"

    Next r
Set rng = Nothing

Next c
End With
End Sub