vba Dictionary - Sum ranges as per criteria

Mallesh23

Well-known Member
Joined
Feb 4, 2009
Messages
837
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: 8

Some videos you may like

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
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
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
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
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows
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
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
6,977
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
52,898
Office Version
  1. 365
Platform
  1. Windows
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
 

Mallesh23

Well-known Member
Joined
Feb 4, 2009
Messages
837
Office Version
  1. 2010
Platform
  1. Windows
Hi Yongle and Fluff.

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

Regards,
mg
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
52,898
Office Version
  1. 365
Platform
  1. Windows
Glad we could help & thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,122,447
Messages
5,596,207
Members
414,045
Latest member
Xlence

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
Top