Snasui Excel Forum

Code: Select all

Sub SumColorValues()
Dim Num As Long
Num=0
Dim lR As Long,i As Long
With Sheet1
lR=.Range("A"&Rows.Count).End(xlUp).Row
For i=2 To lR
If .Range("A"&i).Interior.ColorIndex=
.Range("E"&i).Interior.ColorIndex Then
Num=Num+.Range("A"&i).Value
End If
Next 
.Range("F"&i).Value=Num
End With
End Sub

Code: Select all

Sub SumColorValues()
    Dim Num As Long
    Dim lr As Long, i As Long
    Dim lr1 As Long, j As Integer
    With Sheet1
        lr = .Range("A" & .Rows.Count).End(xlUp).Row
        lr1 = .Range("F" & .Rows.Count).End(xlUp).Row
        For j = 2 To lr1
            Num = 0
            For i = 2 To lr
                If .Range("A" & i).Interior.ColorIndex = _
                    .Range("F" & j).Interior.ColorIndex And _
                    .Range("A" & i).Value = .Range("F" & j).Value Then
                    Num = Num + .Range("B" & i).Value
                End If
            Next i
            .Range("G" & j).Value = Num
        Next j
    End With
End Sub