Private Sub Worksheet_Change(ByVal Target As Range)
Dim r1 As Range, rIN As Range, rTPS As Range, idSPE$, total#
If Target.Count > 1 Then Exit Sub
Set r1 = Range("B5:I35")
If Not Intersect(Target, r1) Is Nothing Then
If Target.Column Mod 2 = 0 Then
idSPE = Cells(3, Target.Column)
Set rTPS = Intersect(Columns(Target.Column), r1)
Set rIN = Intersect(Columns(Target.Column), r1).Offset(0, 1)
Else
idSPE = Cells(3, Target.Column - 1)
Set rTPS = Intersect(Columns(Target.Column), r1).Offset(0, -1)
Set rIN = Intersect(Columns(Target.Column), r1)
End If
For Each c In Range("IN")
If c.Offset(0, 1) <> 0 Then
If Application.CountIf(rIN, c) > 0 Then
total = total + Application.SumIf(rIN, c, rTPS) * c.Offset(0, 1)
End If
End If
Next
Range(idSPE) = total
End If
End Sub