Excel VBA Dictionary excel vba 字典大全

Excel VBA Dictionary - A Complete Guide - Excel Macro Mastery

A Quick Guide to the VBA Dictionary

Function	Params
Early binding reference	“Microsoft Scripting Runtime” (Add using Tools->References from the VB menu)
Declare (early binding)	Dim dict As Scripting.Dictionary
Create(early binding)	Set dict = New Scripting.Dictionary
Declare (late binding)	Dim dict As Object
Create(late binding)	Set dict = CreateObject("Scripting.Dictionary")
Add item (key must not already exist)	dict.Add Key, Value e.g. dict.Add "Apples", 50
Change value at key. Automatically adds if the key does not exist.	dict(Key) = Value e.g. dict("Oranges") = 60
Get a value from the dictionary using the key	Value = dict(Key) e.g. appleCount = dict("Apples")
Check if key exists	dict.Exists(Key) e.g. If dict.Exists("Apples") Then
Remove item	dict.Remove Key e.g. dict.Remove "Apples"
Remove all items	dict.RemoveAll
Go through all items (for each loop)	Dim key As Variant For Each key In dict.Keys Debug.Print key, dict(key) Next key
Go through all items (for loop - early binding only)	Dim i As Long For i = 0 To dict.Count - 1 Debug.Print dict.Keys(i), dict.Items(i) Next i
Go through all items (for loop - early and late binding)	Dim i As Long For i = 0 To dict.Count - 1 Debug.Print dict.Keys()(i), dict.Items()(i) Next i
Get the number of items	dict.Count
Make key case sensitive (the dictionary must be empty).	dict.CompareMode = vbBinaryCompare
Make key non case sensitive (the dictionary must be empty).	dict.CompareMode = vbTextCompare

What is the VBA Dictionary?

In VBA we use Arrays and Collections to store groups of values. For example, we could use them to store a list of customer names, student marks or a list of values from a range of cells.

A Dictionary is similar to a Collection. Using both types, we can name an item when we add it. Imagine we are storing the count of different fruit types.

We could use both a Collection and a Dictionary like this

' Add to Dictionary
dict.Add Key:="Apple", Item:=5' Add to Collection
coll.Add Item:=5, Key:="Apple"

Example of Key, Value pairs

In both cases, we are storing the value 5 and giving it the name “Apple”. We can now get the value of Apple from both types like this

' Get value from Dictionary
Total = dict("Apple")' Get value from Collection
Total = coll("Apple")

So far so good. The Collection however, has two major faults

We cannot check if the key already exists.
We cannot change the value of an existing item.

The first issue is pretty easy to get around: Check Collection Key exists. The second is more difficult.

The VBA Dictionary does not have these issues. You can check if a Key exists and you can change the Item and the Key.

For example, we can use the following code to check if we have an item called Apple.

If dict.Exists("Apple") Then dict("Apple") = 78

These may seem very simple differences. However, it means that the Dictionary is very useful for certain tasks. Particularly when we need to retrieve the value of an item.

Download the Source Code

Download the Dictionary VBA Code

Enter your email to get the Excel VBA code for this post plus exclusive content not available on the website

Enter your email address here...GET THE VBA CODE

Dictionary Webinar

If you are a member of the VBA Vault, then click on the image below to access the webinar and the associated source code.

(Note: Website members have access to the full webinar archive.)

A Dictionary in real world terms

If you are still not clear about a Dictionary then think of it this way. A real-world dictionary has a list of keys and items. The Keys are the words and the Items are the definition.

When you want to find the definition of a word you go straight to that word. You don’t read through every item in the Dictionary.

A second real world example is a phone book(remember those?). The Key in a phone book is the name\address and the Item is the phone number. Again you use the name\address combination to quickly find a phone number.

In Excel the VLookup function works in a similar way to a Dictionary. You look up an item based on a unique value.

A Simple Example of using the VBA Dictionary

The code below give a simple but elegant example of using the Dictionary. It does the following

Adds three fruit types and a value for each to a Dictionary.
The user is asked to enter the name of a fruit.
The code checks if this fruit is in the Dictionary.
If yes then it displays the fruit name and the value.
If no then it informs the user the fruit does not exist.

' https://excelmacromastery.com/
Sub CheckFruit()' Select Tools->References from the Visual Basic menu.' Check box beside "Microsoft Scripting Runtime" in the list.Dim dict As New Scripting.Dictionary' Add to fruit to Dictionarydict.Add key:="Apple", Item:=51dict.Add key:="Peach", Item:=34dict.Add key:="Plum", Item:=43Dim sFruit As String' Ask user to enter fruitsFruit = InputBox("Please enter the name of a fruit")If dict.Exists(sFruit) ThenMsgBox sFruit & " exists and has value " & dict(sFruit)ElseMsgBox sFruit & " does not exist."End IfSet dict = NothingEnd Sub

This is a simple example but it shows how useful a Dictionary is. We will see a real world example later in the post. Let’s look at the basics of using a Dictionary.

Creating a Dictionary

To use the Dictionary you need to first add the reference.

Select Tools->References from the Visual Basic menu.
Find Microsoft Scripting Runtime in the list and place a check in the box beside it.

We declare a dictionary as follows

Dim dict As New Scripting.Dictionary

Dim dict As Scripting.Dictionary
Set dict = New Scripting.Dictionary

Creating a Dictionary in this way is called “Early Binding”. There is also “Late Binding”. Let’s have a look at what this means.

Early versus Late Binding

To create a Dictionary using Late binding we use the following code. We don’t need to add a reference.

Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")

In technical terms Early binding means we decide exactly what we are using up front. With Late binding this decision is made when the application is running. In simple terms the difference is

Early binding requires a reference. Late binding doesn’t.
Early binding allows access to *Intellisense. Late binding doesn’t.
Early binding may require you to manually add the Reference to the “Microsoft Scripting Runtime” for some users.

(*Intellisense is the feature that shows you the available procedures and properties of an item as you are typing.)

While Microsoft recommends that you use early binding in almost all cases I would differ. A good rule of thumb is to use early binding when developing the code so that you have access to the Intellisense. Use late binding when distributing the code to other users to prevent various library conflict errors occurring.

Adding Items to the Dictionary

Function	Params	Example
Add	Key, Item	dict.Add "Apples", 50

We can add items to the dictionary using the Add function. Items can also be added by assigning a value which we will look at in the next section.

Let’s look at the Add function first. The Add function has two parameters: Key and Item. Both must be supplied

dict.Add Key:="Orange", Item:=45
dict.Add "Apple", 66
dict.Add "12/12/2015", "John"
dict.Add 1, 45.56

In the first add example above we use the parameter names. You don’t have to do this although it can be helpful when you are starting out.

The Key can be any data type. The Item can be any data type, an object, array, collection or even a dictionary. So you could have a Dictionary of Dictionaries, Array and Collections. But most of the time it will be a value(date, number or text).

If we add a Key that already exists in the Dictionary then we will get the error

The following code will give this error

dict.Add Key:="Orange", Item:=45' This line gives an error as key exists already
dict.Add Key:="Orange", Item:=75

Assigning a Value

Operation	Format	Example
Assign	Dictionary(Key) = Item	dict("Oranges") = 60

We can change the value of a key using the following code

dict("Orange") = 75

Assigning a value to Key this way has an extra feature. If the Key does not exist it automatically adds the Key and Item to the dictionary. This would be useful where you had a list of sorted items and only wanted the last entry for each one.

' Adds Orange to the dictionary
dict("Orange") = 45 ' Changes the value of Orange to 100
dict("Orange") = 100

Don’t forget that you can download all the VBA code used in this post from the top or bottom of the post.

Checking if a Key Exists

Function	Parameters	Example
Exists	Key	If dict.Exists("Apples") Then

We can use the Exists function to check if a key exists in the dictionary

' Checks for the key 'Orange' in the dictionary
If dict.Exists("Orange") ThenMsgBox "The number of oranges is " & dict("Orange")
ElseMsgBox "There is no entry for Orange in the dictionary."
End If

Storing Multiple Values in One Key

Take a look at the sample data below. We want to store the Amount and Items for each Customer ID.

The Dictionary only stores one value so what can we do?

We could use an array or collection as the value but this is unnecessary. The best way to do it is to use a Class Module.

The following code shows how we can do this

' clsCustomer Class Module Code
Public CustomerID As String
Public Amount As Long
Public Items As Long

' Create a new clsCustomer object
Set oCust = New clsCustomer' Set the values
oCust.CustomerID = rg.Cells(i, 1).Value
oCust.Amount = rg.Cells(i, 2).Value
oCust.Items = rg.Cells(i, 3).Value' Add the new clsCustomer object to the dictionary
dict.Add oCust.CustomerID, oCust

You can see that by using the Class Module we can store as many fields as we want. The examples 2 and 3 at the bottom of the post show how to use a class module with a Dictionary

Other useful functions

Function	Parameters	Example
Count	N/A	dict.Count
Remove	Key	dict.Remove "Apples"
RemoveAll	N/A	dict.RemoveAll

The three functions in the above table do the following:

Count – returns the number of items in the Dictionary.
Remove – removes a given key from the Dictionary.
RemoveAll – removes all items from the Dictionary

The following sub shows an example of how you would use these functions

' https://excelmacromastery.com/
Sub AddRemoveCount()Dim dict As New Scripting.Dictionary' Add some itemsdict.Add "Orange", 55dict.Add "Peach", 55dict.Add "Plum", 55Debug.Print "The number of items is " & dict.Count' Remove one itemdict.Remove "Orange"Debug.Print "The number of items is " & dict.Count' Remove all itemsdict.RemoveAllDebug.Print "The number of items is " & dict.CountEnd Sub

Remember that you can download all the code examples from the post. Just go to the download section at the top.

The Key and Case Sensitivity

Some of the string functions in VBA have a vbCompareMethod. This is used for functions that compare strings. It is used to determine if the case of the letters matter.

© BigStockPhoto.com

The Dictionary uses a similar method. The CompareMode property of the Dictionary is used to determine if the case of the key matters. The settings are

vbTextCompare: Upper and lower case are considered the same.

vbBinaryCompare: Upper and lower case are considered different. This is the default.

With the Dictionary we can use these settings to determine if the case of the key matters.

' https://excelmacromastery.com/
Sub CaseMatters()Dim dict As New Scripting.Dictionarydict.CompareMode = vbBinaryComparedict.Add "Orange", 1' Prints False because it considers Orange and ORANGE different Debug.Print dict.Exists("ORANGE")    Set dict = NothingEnd Sub

This time we use vbTextCompare which means that the case does not matter

' https://excelmacromastery.com/
Sub CaseMattersNot()Dim dict As New Scripting.Dictionarydict.CompareMode = vbTextComparedict.Add "Orange", 1' Prints true because it considers Orange and ORANGE the sameDebug.Print dict.Exists("ORANGE")    Set dict = NothingEnd Sub

Note: The Dictionary must be empty when you use the CompareMode property or you will get the error: “Invalid procedure call or argument”.

Things to Watch Out For

vbBinaryCompare (the case matters) is the default and this can lead to subtle errors. For example, imagine you have the following data in cells A1 to B2.

Orange, 5
orange, 12

The following code will create two keys – on for “Orange” and one for “orange”. This is subtle as the only difference is the case of the first letter.

' https://excelmacromastery.com/
Sub DiffCase()Dim dict As New Scripting.Dictionarydict.Add Key:=(Range("A1")), Item:=Range("B1")dict.Add Key:=(Range("A2")), Item:=Range("B2")End Sub

If you do use vbTextCompare for the same data you will get an error when you try to add the second key as it considers “Orange” and “orange” the same.

' https://excelmacromastery.com/
Sub UseTextcompare()Dim dict As New Scripting.Dictionarydict.CompareMode = vbTextComparedict.Add Key:=(Range("A1")), Item:=Range("B1")' This line will give an error as your are trying to add the same keydict.Add Key:=(Range("A2")), Item:=Range("B2")End Sub

If you use the assign method then it does not take the CompareMode into account. So the following code will still add two keys even though the CompareMode is set to vbTextCompare.

' https://excelmacromastery.com/
Sub Assign()Dim dict As New Scripting.Dictionarydict.CompareMode = vbTextCompare' Adds two keysdict(Range("A1")) = Range("B1")dict(Range("A2")) = Range("B2")' Prints 2Debug.Print dict.CountEnd Sub

Reading through the Dictionary

We can read through all the items in the Dictionary. We can go through the keys using a For Each loop. We then use the current key to access an item.

Dim k As Variant
For Each k In dict.Keys' Print key and valueDebug.Print k, dict(k)
Next

We can also loop through the keys although this only works with Early Binding(Update Feb 2020: In Office 365 this now works with both versions):

Dim i As Long
For i = 0 To dict.Count - 1Debug.Print dict.Keys(i), dict.Items(i)
Next i

This method works with both Early and Late binding:

Dim i As Long
For i = 0 To dict.Count - 1Debug.Print dict.Keys()(i), dict.Items()(i)
Next i

Sorting the Dictionary

Sometimes you may wish to sort the Dictionary either by key or by value.

The Dictionary doesn’t have a sort function so you have to create your own. I have written two sort functions – one for sorting by key and one for sorting by value.

Sorting by keys

To sort the dictionary by the key you can use the SortDictionaryByKey function below

' https://excelmacromastery.com/
Public Function SortDictionaryByKey(dict As Object _, Optional sortorder As XlSortOrder = xlAscending) As ObjectDim arrList As ObjectSet arrList = CreateObject("System.Collections.ArrayList")' Put keys in an ArrayListDim key As Variant, coll As New CollectionFor Each key In dictarrList.Add keyNext key' Sort the keysarrList.Sort' For descending order, reverseIf sortorder = xlDescending ThenarrList.ReverseEnd If' Create new dictionaryDim dictNew As ObjectSet dictNew = CreateObject("Scripting.Dictionary")' Read through the sorted keys and add to new dictionaryFor Each key In arrListdictNew.Add key, dict(key)Next key' Clean upSet arrList = NothingSet dict = Nothing' Return the new dictionarySet SortDictionaryByKey = dictNewEnd Function

The code below, shows you how to use SortDictionaryByKey

' https://excelmacromastery.com/
Sub TestSortByKey()Dim dict As ObjectSet dict = CreateObject("Scripting.Dictionary")dict.Add "Plum", 99dict.Add "Apple", 987dict.Add "Pear", 234dict.Add "Banana", 560dict.Add "Orange", 34PrintDictionary "Original", dict' Sort AscendingSet dict = SortDictionaryByKey(dict)PrintDictionary "Key Ascending", dict' Sort DescendingSet dict = SortDictionaryByKey(dict, xlDescending)PrintDictionary "Key Descending", dictEnd SubPublic Sub PrintDictionary(ByVal sText As String, dict As Object)Debug.Print vbCrLf & sText & vbCrLf & String(Len(sText), "=")Dim key As VariantFor Each key In dict.keysDebug.Print key, dict(key)Next
End Sub

Sorting by values

To sort the dictionary by the values you can use the SortDictionaryByValue function below.

' https://excelmacromastery.com/
Public Function SortDictionaryByValue(dict As Object _, Optional sortorder As XlSortOrder = xlAscending) As ObjectOn Error GoTo ehDim arrayList As ObjectSet arrayList = CreateObject("System.Collections.ArrayList")Dim dictTemp As ObjectSet dictTemp = CreateObject("Scripting.Dictionary")' Put values in ArrayList and sort' Store values in tempDict with their keys as a collectionDim key As Variant, value As Variant, coll As CollectionFor Each key In dictvalue = dict(key)' if the value doesn't exist in dict then addIf dictTemp.exists(value) = False Then' create collection to hold keys' - needed for duplicate valuesSet coll = New CollectiondictTemp.Add value, coll' Add the valuearrayList.Add valueEnd If' Add the current key to the collectiondictTemp(value).Add keyNext key' Sort the valuearrayList.Sort' Reverse if descendingIf sortorder = xlDescending ThenarrayList.ReverseEnd Ifdict.RemoveAll' Read through the ArrayList and add the values and corresponding' keys from the dictTempDim item As VariantFor Each value In arrayListSet coll = dictTemp(value)For Each item In colldict.Add item, valueNext itemNext valueSet arrayList = Nothing' Return the new dictionarySet SortDictionaryByValue = dictDone:Exit Function
eh:If Err.Number = 450 ThenErr.Raise vbObjectError + 100, "SortDictionaryByValue" _, "Cannot sort the dictionary if the value is an object"End If
End Function

The code below shows you how to use SortDictionaryByValue

' https://excelmacromastery.com/
Sub TestSortByValue()Dim dict As ObjectSet dict = CreateObject("Scripting.Dictionary")dict.Add "Plum", 99dict.Add "Apple", 987dict.Add "Pear", 234dict.Add "Banana", 560dict.Add "Orange", 34PrintDictionary "Original", dict' Sort AscendingSet dict = SortDictionaryByValue(dict)PrintDictionary "Value Ascending", dict' Sort DescendingSet dict = SortDictionaryByValue(dict, xlDescending)PrintDictionary "Value Descending", dictEnd SubPublic Sub PrintDictionary(ByVal sText As String, dict As Object)Debug.Print vbCrLf & sText & vbCrLf & String(Len(sText), "=")Dim key As VariantFor Each key In dict.keysDebug.Print key, dict(key)Next keyEnd Sub

Troubleshooting the Dictionary

This section covers the common errors you may encounter using the Dictionary.

Missing Reference

Issue: You get the error message “User-defined type not defined”
This normally happens when you create the Dictionary but forget to add the reference.

Dim dict As New Scripting.Dictionary

Resolution: Select Tools->Reference from the Visual Basic menu. Place a check in the box beside “Microsoft Scripting Runtime”.

See Section: Creating a Dictionary

Exists is not Working

Issue: You have added a key to the Dictionary but when you use the Exists function it returns false
This is normally an issue with Case Sensitivity(see above).
The following code adds “Apple” as a key. When we check for “apple” it returns false. This is because it takes the case of the letters into account:

dict.Add "Apple", 4If dict.Exists("apple") ThenMsgBox "Exists"
ElseMsgBox "Does not Exist"
End If

You can set the CompareMode property to vbTextCompare and this will ignore the case:

Dim dict As New Scripting.Dictionary
dict.CompareMode = vbTextCompare

Resolution: Set the CompareMode to vbTextCompare to ignore case or ensure your data has the correct case.

See Section: The Key and Case Sensitivity

Object Variable Error

Issue: You get the error message “Object variable or With block variable not set” when you try to use the Dictionary.

The normally happens when you forget to use New before you use the Dictionary. For example, the following code will cause this error

Dim dict As Scripting.Dictionary
' This line will give "Object variable..." error
dict.Add "Apple", 4

Resolution: Use the New keyword when creating the Dictionary

Dim dict As New Scripting.Dictionary

Dim dict As Scripting.Dictionary
Set dict = New Scripting.Dictionary

See Section: Creating a Dictionary

Useful Tips for Troubleshooting the Dictionary

If you are investigating an issue with the Dictionary it can be useful to see the contents.

Use the following sub to Print each Key and Item to the Immediate Window(Ctrl + G).

' https://excelmacromastery.com/
Sub PrintContents(dict As Scripting.Dictionary)Dim k As VariantFor Each k In dict.Keys' Print key and valueDebug.Print k, dict(k)NextEnd Sub

You can use it like this

Dim dict As Scripting.Dictionary
Set dict = New Scripting.Dictionary' Add items to Dictionary here' Print the contents of the Dictionary to the Immediate Window
PrintContents dict

If you are stepping through the code you can also add dict.Count to the Watch Window to see how many items are currently in the Dictionary. Right-click anywhere in the code window and select Add Watch. Type dict.Count into the text box and click Ok.

You can also use the Dictionary itself as a Watch. Add Dict to the Watch window. If you click on the plus sign you will see the contents of the Dictionary. This can be useful but it only shows the key and not the item.

Note: You can only view Watches when the code is running.

Remember that you can download all the code examples from the post. Just go to the download section at the top.

Copying the Dictionary to an Array

As we know the dictionary is made up of Key and Value pairs. The dictionary has a Keys property which is an array of all the keys and an Items property which is an array of all the items(i.e. values).

As both of these properties are arrays, we can write them directly to a worksheet as we will see in the next section.

If we want to copy either the Keys or Items array to a new array then we can do it very easily like this:

Dim arr As Variant
arr = dict.Keys

The following example copies the Keys and Items arrays to new arrays. Then the contents of the new arrays are printed to the Immediate Window:

Sub DictionaryToArray()' Create dictionary and add entriesDim dict As New Dictionarydict.Add "France", 56dict.Add "USA", 23dict.Add "Australia", 34' Declare variant to use as arrayDim arr As Variant' Copy keys to arrayarr = dict.Keys' Print array to Immediate Window(Ctrl + G to View)Call PrintArrayToImmediate(arr, "Keys:")' Copy items to arrayarr = dict.Items' Print array to Immediate Window(Ctrl + G to View)Call PrintArrayToImmediate(arr, "Items:")End Sub' Prints an array to the Immediate Window(Ctrl + G to View)
Sub PrintArrayToImmediate(arr As Variant, headerText As String)Debug.Print vbNewLine & headerTextDim entry As VariantFor Each entry In arrDebug.Print entryNextEnd Sub

When you run the code you wil get the following output:

Note that you can only copy the Items array when it contains basic data types like string, long, date, double etc. If the items are objects then you can not copy them to an array. You’ll need to read through the dictionary using a loop instead.

Writing the Dictionary to the Worksheet

We can write the Dictionary keys or items to the worksheet in one line of code.

When you write out the keys or items they will be written to a row. If you want to write them to a column you can use the WorksheetFunction.Transpose function.

The code below shows examples of how to write the Dictionary to a worksheet:

Sub DictionaryToWorksheet()Dim dict As New Dictionarydict.Add "France", 56dict.Add "USA", 23dict.Add "Australia", 34Dim sh As WorksheetSet sh = ThisWorkbook.Worksheets("Sheet1")' Write keys to range A1:C1sh.Range("A1:C1").Value = dict.Keys' Write items to range A2:C2sh.Range("A2:C2").Value = dict.Items' Write keys to range E1:E3sh.Range("E1:E3").Value = WorksheetFunction.Transpose(dict.Keys)' Write items to range F1:F3sh.Range("F1:F3").Value = WorksheetFunction.Transpose(dict.Items)End Sub

Useful Dictionary Examples

The easiest way to see the benefits of the Dictionary is to see some real-world examples of it’s use. So in this section we are going to look at some examples. You can get workbooks and code for these examples by entering your email below:

Download the Dictionary VBA Code

Enter your email to get the Excel VBA code for this post plus exclusive content not available on the website

Enter your email address here...GET THE VBA CODE

Example 1 – Summing Single Values

Let’s have a look at a real-world example of using a dictionary. Our data for this example is the World Cup Final matches from 2014.

Our task here is to get the number of goals scored by each team.

The first thing we need to do is to read all the data. The following code reads through all the matches and prints the names of the two teams involved.

' https://excelmacromastery.com/vba-dictionary
' Reads the World Cup data from the 2014 Worksheet
' View the results in the Immediate Window(Ctrl + G)
Sub GetTotals()' Get worksheetDim wk As WorksheetSet wk = ThisWorkbook.Worksheets("2014")' Get range for all the matchesDim rg As RangeSet rg = wk.Range("A1").CurrentRegionDim Team1 As String, Team2 As StringDim Goals1 As Long, Goals2 As LongDim i As LongFor i = 2 To rg.Rows.Count' read the data from each matchTeam1 = rg.Cells(i, 5).ValueTeam2 = rg.Cells(i, 9).ValueGoals1 = rg.Cells(i, 6).ValueGoals2 = rg.Cells(i, 7).Value' Print each teams/goals to Immediate Window(Ctrl + G)Debug.Print Team1, Team2, Goals1, Goals2Next iEnd Sub

What we want to do now is to store each team and the goals they scored. When we meet a team for the first time we add the name as a Key and the number of goals as the Item.

If the team has already been added then we add the goals they scored in the current match to their total.

We can use the following line to add goals to the current team:

dict(Team1) = dict(Team1) + Goals1

This line is very powerful.

If the teams exists in the Dictionary, the current goals are added to the current total for that team.

If the team does not exist in the Dictionary then it will automatically add the team to the Dictionary and set the value to the goals.

For example, imagine the Dictionary has one entry

Key, Value
Brazil, 5

Then

dict("Brazil") = dict("Brazil") + 3

will update the dictionary so it now looks like this

Key, Value
Brazil, 8

The line

dict("France") = dict("France") + 3

will update the dictionary so it now looks like this

Key, Value
Brazil, 8
France, 3

This saves us having to write code like this:

If dict.Exists(Team1) Then' If exists add to totaldict(Team) = dict(Team) + Goals1
Else' if doesn't exist then adddict(Team) = Goals1
End If

We write out the values from the Dictionary to the worksheet as follows:

' Write the data from the dictionary to the worksheet
' https://excelmacromastery.com/vba-dictionary
Private Sub WriteDictionary(dict As Scripting.Dictionary _, shReport As Worksheet)ClearData shReport' Write the keysshReport.Range("A1").Resize(dict.Count, 1).Value = WorksheetFunction.Transpose(dict.Keys)' Write the itemsshReport.Range("B1").Resize(dict.Count, 1).Value = WorksheetFunction.Transpose(dict.Items)End Sub

We obviously want the scores to be sorted. It is much easier to read this way. There is no easy way to sort a Dictionary. The way to do it is to copy all the items to an array. Sort the array and copy the items back to a Dictionary.

What we can do is sort the data once it has been written to the worksheet. We can use the following code to do this:

' Sort the data on the worksheet
' https://excelmacromastery.com/vba-dictionary
Public Sub SortByScore(shReport As Worksheet _, Optional sortOrder As XlSortOrder = xlDescending)Dim rg As RangeSet rg = shReport.Range("A1").CurrentRegionrg.Sort rg.Columns("B"), sortOrderEnd Sub

Our final GetTotals sub looks like this:

' https://excelmacromastery.com/vba-dictionary
Sub GetTotalsFinal()' Create dictionaryDim dict As New Scripting.Dictionary' Get worksheetDim sh As WorksheetSet sh = ThisWorkbook.Worksheets("2014")' Get rangeDim rgMatches As RangeSet rgMatches = sh.Range("A1").CurrentRegionDim team1 As String, team2 As StringDim goals1 As Long, goals2 As LongDim i As Long' Read through the range of dataFor i = 2 To rgMatches.Rows.Count' read the data to variablesteam1 = rgMatches.Cells(i, 5).Valueteam2 = rgMatches.Cells(i, 9).Valuegoals1 = rgMatches.Cells(i, 6).Valuegoals2 = rgMatches.Cells(i, 7).Value' Add the totals for each team to the dictionary.' If the team doesn't exist it will be automatically addeddict(team1) = dict(team1) + goals1dict(team2) = dict(team2) + goals2Next i' Get the report worksheetDim shReport As WorksheetSet shReport = ThisWorkbook.Worksheets("2014 Report")' Write the teams and scores to the worksheetWriteDictionary dict, shReport' Sort the range' Change to xlAscending to reverse the orderSortByScore shReport, xlDescending' Clean upSet dict = NothingshReport.ActivateEnd Sub

When you run this code you will get the following results

Teams ordered by number of goals scored

Example 2 – Dealing with Multiple Values

We are going to use the data from the Multiple Values section above

Imagine this data starts at cell A1. Then we can use the code below to read to the dictionary.

The code includes two subs for displaying the data:

WriteToImmediate prints the contents of the dictionary to the Immediate Window.
WriteToWorksheet writes the contents of the dictionary to the worksheet called Output.

To run this example:

Create a worksheet called Customers.
Add the above data to the worksheet starting at cell A1.
Create a worksheet called Output and leave it blank.
Go to the Visual Basic Editor(Alt + F11).
Select Tools->Reference and then check “Microsoft Scripting Runtime” from the list.
Create a new class module and add the first piece of code from below.
Create a new standard module and add the second piece of code from below.
Press F5 to run and select Main from the menu.
Check the ImmediateWindow(Ctrl + G) and the Output worksheet to see the results.

' clsCustomer Class Module Code
Public CustomerID As String
Public Amount As Long
Public Items As Long

' Standard module Code
' https://excelmacromastery.com/
Sub Main()Dim dict As Dictionary' Read the data to the dictionarySet dict = ReadMultiItems' Write the Dictionary contents to the Immediate Window(Ctrl + G)WriteToImmediate dict' Write the Dictionary contents to a worksheetWriteToWorksheet dict, ThisWorkbook.Worksheets("Output")End SubPrivate Function ReadMultiItems() As Dictionary' Declare and create the DictionaryDim dict As New Dictionary' Get the worksheetDim sh As WorksheetSet sh = ThisWorkbook.Worksheets("Customers")' Get the range of all the adjacent data using CurrentRegionDim rg As RangeSet rg = sh.Range("A1").CurrentRegionDim oCust As clsCustomer, i As Long' read through the dataFor i = 2 To rg.Rows.Count' Create a new clsCustomer objectSet oCust = New clsCustomer' Set the valuesoCust.CustomerID = rg.Cells(i, 1).ValueoCust.Amount = rg.Cells(i, 2).ValueoCust.Items = rg.Cells(i, 3).Value' Add the new clsCustomer object to the dictionarydict.Add oCust.CustomerID, oCustNext i' Return the dictionary to the Main subSet ReadMultiItems = dictEnd Function' Write the Dictionary contents to the Immediate Window(Ctrl + G)
' https://excelmacromastery.com/
Private Sub WriteToImmediate(dict As Dictionary)Dim key As Variant, oCust As clsCustomer' Read through the dictionaryFor Each key In dict.KeysSet oCust = dict(key)With oCust' Write to the Immediate Window (Ctrl + G)Debug.Print .CustomerID, .Amount, .ItemsEnd WithNext keyEnd Sub' Write the Dictionary contents  to a worksheet
' https://excelmacromastery.com/
Private Sub WriteToWorksheet(dict As Dictionary, sh As Worksheet)' Delete all existing data from the worksheetsh.Cells.ClearContentsDim row As Longrow = 1Dim key As Variant, oCust As clsCustomer' Read through the dictionaryFor Each key In dict.KeysSet oCust = dict(key)With oCust' Write out the valuessh.Cells(row, 1).Value = .CustomerIDsh.Cells(row, 2).Value = .Amountsh.Cells(row, 3).Value = .Itemsrow = row + 1End WithNext keyEnd Sub

Example 3 – Summing Multiple Values

In this example were are going to make a small update to Example 2. In that example there was only one entry per customer in the data.

This time there will be multiple entries for some customers and we want to sum the total Amount and total Items for each customer.

See the updated dataset below:

Note: If you run the “Example 2” code on data with multiple copies of the CustomerID, it will give the “Key already exists error”.

' clsCustomer Class Module Code
Public CustomerID As String
Public Amount As Long
Public Items As Long

' Read from worksheet: CustomerSum
' Write to worksheet: CustomerRepSum
' https://excelmacromastery.com/vba-dictionary
Sub MainSum()Dim dict As Dictionary' Read the data to the dictionarySet dict = ReadMultiItemsSum' Write the Dictionary contents to the Immediate Window(Ctrl + G)WriteToImmediate dict' Write the Dictionary contents to a worksheetWriteToWorksheet dict, ThisWorkbook.Worksheets("CustomerRepSum")End Sub' Read multiple items but this time sums the items
' https://excelmacromastery.com/
Private Function ReadMultiItemsSum() As Dictionary' Declare and Create the DictionaryDim dict As New Dictionary' Get the worksheetDim sh As WorksheetSet sh = ThisWorkbook.Worksheets("CustomerSum")' Get the range of all the adjacent data using CurrentRegionDim rg As RangeSet rg = sh.Range("A1").CurrentRegionDim oCust As clsCustomer, i As Long, customerID As String' read through the dataFor i = 2 To rg.Rows.CountcustomerID = rg.Cells(i, 1).Value' check if the customerID has been added alreadyIf dict.Exists(customerID) = True Then' Get the existing customer objectSet oCust = dict(customerID)Else' Create a new clsCustomer objectSet oCust = New clsCustomer' Add the new clsCustomer object to the dictionarydict.Add customerID, oCustEnd If' Set the valuesoCust.Amount = oCust.Amount + rg.Cells(i, 2).ValueoCust.Items = oCust.Items + rg.Cells(i, 3).ValueNext i' Return the dictionary to the Main subSet ReadMultiItemsSum = dictEnd Function' Write the Dictionary contents to the Immediate Window(Ctrl + G)
' https://excelmacromastery.com/vba-dictionary
Private Sub WriteToImmediate(dict As Dictionary)Dim key As Variant, oCust As clsCustomer' Read through the dictionaryFor Each key In dict.KeysSet oCust = dict(key)With oCust' Write to the Immediate Window (Ctrl + G)Debug.Print key, .Amount, .ItemsEnd WithNext keyEnd Sub' Write the Dictionary contents  to a worksheet
' https://excelmacromastery.com/
Private Sub WriteToWorksheet(dict As Dictionary, sh As Worksheet)' Delete all existing data from the worksheetsh.Cells.ClearContentsDim row As Longrow = 1Dim key As Variant, oCust As clsCustomer' Read through the dictionaryFor Each key In dict.KeysSet oCust = dict(key)With oCust' Write out the valuessh.Cells(row, 1).Value = keysh.Cells(row, 2).Value = .Amountsh.Cells(row, 3).Value = .Itemsrow = row + 1End WithNext keyEnd Sub

When To Use The Dictionary

So when should you use the VBA Dictionary? When you have a task where:

You have a list of unique items e.g. countries, invoice numbers, customer name and addresses, project ids, product names etc.
You need to retrieve the value of a unique item.