Calculatin within an Array - arrays

Question

I'm a little bit familiar with VBA Excel 2013. My problem now is, that I need to sum the values where specific Strings are available.
I need to calculate within a column only the values where a lookup is true.
My table looks like:
9 | AD,DCO,PD
5 | AD
5 | PD
15 | PD
So the sum for AD would be 14 or DCO would be 9 or PD would be 29 an therefore the result table have to look like this:
AD | DCO | PD
—–—–—–—–—–––—–
14 | 9 | 29
Can anybody help me?

Answer 1

Forget VBA. Sumproduct solves this perfectly.
I'm assuming that your commas separate cells, so Column A has the numbers, then columns B-D have the letters. If they do not, you can always use the Text to Columns function in excel (look under the Data tab) to make this so.
Put the following function where you wnat the answer (say, B10):
=SUMPRODUCT(($A$1:$A$4) * ($B$1:$D$4 = $A$10))
You can then type in cell A10 the code letter and it will sum up column A, where columns B-D contain that text.
If you want to display all text options, you can make a list of them (say A10 = AD, A11 = DCO, A12 = PD), then in B10 put the same formula as above but remove the $ from in front of the number (so it reads $A10). You can then drag it down and it will tally up for each of the values in A10-A13 and display the results in B10 - B13.

Answer 2

If I have correctly interpreted your sample data into a pseudo-table then the native SUMIF function will conditionally sum the numbers in column A using a wildcard criteria against column B. Example in D2 (as the image below) would be =SUMIF($B$1:$B$4,"*"&D$1&"*",$A$1:$A$4).
             
Fill or copy right as necessary. The caution is that wildcards may make false positives when the criteria closely resembles other values. This is not the case with your sample data.

Answer 3

Problem Solved, but do you have any suggestion to speed up the code?
Sub Calculate()
Dim Dict As Object
Dim i As Long
Dim e As Long
Set Dict = CreateObject("Scripting.Dictionary")
Dim b, m As Long
Dim a As Long
Dim c As Variant
Dim j As Long
Dim sum_Dict As Variant
Dim column_Dict As Variant
i = 1
e = 16
a = i
a = a - 2
For i = i To e
For Each sum_Dict In Range("A" & i & ":" & "A" & e) 'Spalte V = Price
If sum_Dict = "" Then
i = i + 1
Else
For Each c In Range("B" & i & ":F" & i) 'All Columns from B til F
' iterating over the array
For j = LBound(column_Dict) To UBound(column_Dict)
' assigning the separated values to columns
b = CDbl(sum_Dict) 'convert to double
c = CStr(c) 'convert to string
If Dict.Exists(c) Then 'check if key exists
Dict.Item(c) = Dict.Item(c) + b 'if key exists sum the items
Else 'if the key does not exist create it
Dict.Add Key:=c, Item:=b
End If
Next j
Next c
i = i + 1
'extract keys into variant array
'Debug.Print "Array of Keys and items"
For m = 0 To Dict.Count - 1
'Debug.Print Dict.Keys()(m), Dict.Items()(m)
Next m
'Debug.Print Dict.Count & " Items in Dictionary"
End If
Next sum_Dict
Next
'-- output to sheet using first 1D Array
Range("H" & a + 2).Resize(1, _
UBound(Application.Transpose(Dict.Keys()))) = Dict.Keys()
'-- output to sheet using dictionary
Range("H" & a + 3).Resize(1, _
UBound(Application.Transpose(Dict.Items()))) = Dict.Items()
Dict.RemoveAll ' empty dictionary
End Sub