Sub SumsAll()
Dim Cnt, Cur, t, i As Integer
Dim St(100) As String
Dim Sm(100) As Double
Dim Fnd As Boolean
Dim Strn As String
For t = 1 To 100
St(t) = "": Sm(t) = 0
Next t
Cnt = 0: Cur = 0: Fnd = False
rng = ActiveWindow.RangeSelection.Address
For Each rn In Range(rng).Cells
If Len(rn) > 1 And Val(rn) = 0 Then
If Cnt > 0 Then
Fnd = False
For t = 1 To Cnt
If UCase(St(t)) = UCase(rn) Then Cur = t: Fnd = True: GoTo ex
Next t
End If 'Cnt>0
ex:
If Fnd = False Then
Cnt = Cnt + 1
St(Cnt) = rn
Cur = Cnt
End If
Else
Sm(Cur) = Sm(Cur) + rn
End If
Next rn
Strn = ""
For t = 1 To Cnt
Strn = Strn + Mid(St(t), 1, 3) + "=" + CStr(Sm(t))
If t < Cnt Then Strn = Strn + "; "
Next t
Application.StatusBar = Strn
End Sub