vba Dictionary - Sum ranges as per criteria

Mallesh23

Well-known Member
Joined
Feb 4, 2009
Messages
976
Office Version
  1. 2010
Platform
  1. Windows
Hi Team,

Below is my data and I want to sum ranges as per Criteria.
Criteria is in Column E.


looking help in dictionary as I am trying to learn dictionary.


NameScoreCriteria List
Dhoni
10642​
Sehwag
Virat
11498​
Dhoni
Rohit
10857​
Total Scores Made by Sachin and Sehwag
22424​
Sachin
12657​
Sehwag
11782​

Excel formula =SUMPRODUCT(SUMIFS($B$2:$B$6,$A$2:$A$6,$E$2:$E$3)) it works.


Regards,
mg
 

Attachments

  • SumRange.PNG
    SumRange.PNG
    9.1 KB · Views: 38

Excel Facts

Copy a format multiple times
Select a formatted range. Double-click the Format Painter (left side of Home tab). You can paste formatting multiple times. Esc to stop
Does each name occur only ONCE in column A ?
VBA Code:
Sub DictPractice()
    Dim pop As Range, who As Range, nm As Range, total As Double
    Dim dict As Object, k As Variant
    Set pop = Range("A2", Range("A" & Rows.Count).End(xlUp))
    Set who = Range("E2", Range("E" & Rows.Count).End(xlUp))
    Set dict = CreateObject("Scripting.Dictionary")
'add all names from column A to dictionary
    For Each nm In pop
        On Error Resume Next
        dict.Add UCase(nm), nm.Offset(, 1)
        On Error GoTo 0
    Next
'sum values of those in column E
    For Each nm In who
        If dict.Exists(UCase(nm)) Then total = total + dict(UCase(nm))
    Next
    Range("G4") = total
End Sub
 
Upvote 0
If names appear several times and you want all the values for each name added
VBA Code:
Sub DictPractice2()
    Dim pop As Range, who As Range, nm As Range, total As Double
    Dim dict As Object, k As Variant
    Set pop = Range("A2", Range("A" & Rows.Count).End(xlUp))
    Set who = Range("E2", Range("E" & Rows.Count).End(xlUp))
    Set dict = CreateObject("Scripting.Dictionary")
'add all values for all names from column A to dictionary
    For Each nm In pop
        Select Case dict.Exists(UCase(nm))
            Case True: dict(UCase(nm)) = nm.Offset(, 1) + dict(UCase(nm))
            Case Else: dict.Add UCase(nm), nm.Offset(, 1)
        End Select
    Next
'sum values of those in column E
    For Each nm In who
        If dict.Exists(UCase(nm)) Then total = total + dict(UCase(nm))
    Next
    Range("G4") = total
End Sub
 
Upvote 0
This time names in column E are placed in the dictionary
VBA Code:
Sub DictPractice3()
    Dim pop As Range, who As Range, nm As Range, total As Double
    Dim dict As Object, k As Variant
    Set pop = Range("A2", Range("A" & Rows.Count).End(xlUp))
    Set who = Range("E2", Range("E" & Rows.Count).End(xlUp))
    Set dict = CreateObject("Scripting.Dictionary")
'add all names from column E to dictionary
    For Each nm In who
        dict.Add UCase(nm), WorksheetFunction.SumIf(pop, nm, pop.Offset(, 1))
    Next
'sum values of all those in dictionary
    For Each k In dict.keys
        total = total + dict(k)
    Next
    Range("G4") = total
End Sub
 
Upvote 0
This time 2 dictionaries are used

VBA Code:
    Dim pop As Range, who As Range, nm As Range, total As Double
    Dim dict As Object, k As Variant
    Dim dict2 As Object
    Set pop = Range("A2", Range("A" & Rows.Count).End(xlUp))
    Set who = Range("E2", Range("E" & Rows.Count).End(xlUp))
    Set dict = CreateObject("Scripting.Dictionary")
    Set dict2 = CreateObject("Scripting.Dictionary")
'add all names from column E to dictionary dict
    For Each nm In who
        dict.Add UCase(nm), WorksheetFunction.SumIf(pop, nm, pop.Offset(, 1))
    Next
'add all values for all names from column A to dictionary dict2
    For Each nm In pop
        Select Case dict2.exists(UCase(nm))
            Case True: dict2(UCase(nm)) = nm.Offset(, 1) + dict2(UCase(nm))
            Case Else: dict2.Add UCase(nm), nm.Offset(, 1)
        End Select
    Next
'sum values of all those in dictionary
    For Each k In dict.keys
        If dict2.exists(k) Then total = total + dict2(k)
    Next
    Range("G4") = total
End Sub
 
Upvote 0
This is the same as post#4 but avoids using a 2nd loop

VBA Code:
Sub DictPractice5()
    Dim pop As Range, who As Range, nm As Range, total As Double
    Dim dict As Object
    Set pop = Range("A2", Range("A" & Rows.Count).End(xlUp))
    Set who = Range("E2", Range("E" & Rows.Count).End(xlUp))
    Set dict = CreateObject("Scripting.Dictionary")
'add all names from column E to dictionary and build total
    For Each nm In who
        dict.Add UCase(nm), WorksheetFunction.SumIf(pop, nm, pop.Offset(, 1))
        total = total + dict(UCase(nm))
    Next
    Range("G4") = total
End Sub
 
Upvote 0
Another option
VBA Code:
Sub Mallesh()
   Dim Cl As Range
   Dim Score As Long
   
   With CreateObject("scripting.dictionary")
      .CompareMode = 1
      For Each Cl In Range("A2", Range("A" & Rows.Count).End(xlUp))
         .Item(Cl.Value) = .Item(Cl.Value) + Cl.Offset(, 1).Value
      Next Cl
      For Each Cl In Range("E2", Range("E" & Rows.Count).End(xlUp))
         Score = Score + .Item(Cl.Value)
      Next Cl
   End With
   Range("G4").Value = Score
End Sub
 
Upvote 0
Hi Yongle and Fluff.

Millions of thanks both of you(y) ! ? I will practise these code. Thanks.

Regards,
mg
 
Upvote 0
Glad we could help & thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,213,494
Messages
6,113,972
Members
448,537
Latest member
Et_Cetera

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top