Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [d3].Resize(, 4)) Is Nothing Then
Dim eRw As Long, ProSum As Double
Dim jJ As Byte
Dim Rng As Range, sRng As Range
Dim MyAdd As String
eRw = Cells.Find(What:="*", After:=[C1], SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
Set Rng = [c11].Resize(eRw, 4)
For jJ = 65 To 68
Set sRng = Rng.Find(Target.Value, , xlFormulas, xlWhole)
If Not sRng Is Nothing Then
MyAdd = sRng.Address
Do
If Cells(sRng.Row, "B").Value = Chr(jJ) Then _
ProSum = ProSum + sRng.Offset(, 4).Value
Set sRng = Rng.FindNext(sRng)
Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
End If
Target.Offset(jJ - 64).Value = ProSum
ProSum = 0
Next jJ
End If
End Sub