Class objects collection with nested Dictionary. Error: Object variable not set (VBA)

Question

I have some Winners list. Winners have their Names and Presents Budget:

---

And I have some Presents with their Prices:

---

Need to create Class Objects Collection. Class Object has fields:

Public SellerName As String   'Winner name
Public Presents As Scripting.Dictionary   'Dictionary of assigned presents
Public FillLevel As Long   'Total price of his presents

---

So each Class Object stores Winner name, his presents as Dictionary and total price of his presents.

Each winner's presents dictionary should store as much presents as it doesn't exceeds his budget.

• For example Winner1 have only one element in his Presents Dictionary.
• Winner2 have 3 elements is his Presents Dictionary. And both within Budget.
• Each winner receives presents starting from the highest price.

---

So as a result I have Objects Collection of 3 winners (3 elements in Collection).

---

Code:

Sub DistributePrize()
    
    Dim winnersList As New Scripting.Dictionary
    Dim presentsList As New Scripting.Dictionary
        
    'some test data for Winners Dictionary
    winnersList.Add "Winner1", 25000
    winnersList.Add "Winner2", 15000
    winnersList.Add "Winner3", 5000
    
    'some test data for Presents Dictionary
    presentsList.Add "Present1", 25000
    presentsList.Add "Present2", 10000
    presentsList.Add "Present3", 3000
    presentsList.Add "Present4", 2000
    
    'Just sorting presentsList in xlDescending order.      
    Set presentsList = SortDictionaryByValue(presentsList, xlDescending)
            
    Dim winnerKey, presentsKey As Variant
    Dim objectsCollection As New Collection
    Dim EachPresentDict As New Scripting.Dictionary
    
    Dim totalSum As Long
    
    For Each winnerKey In winnersList
    totalSum = 0      
        For Each presentsKey In presentsList
            If EachPresentDict.Exists(presentsKey) = False Then
                If totalSum <= winnersList(presentsKey) Then
                    EachPresentDict.Add presentsKey, presentsList(presentsKey)
                    totalSum = totalSum + CLng(presentsList(presentsKey))
                End If
            End If
         Next presentsKey
            
         objectsCollection.Add GetSellerPresentsObject(CStr(winnerKey), EachPresentDict, CLng(totalSum))
         EachPresentDict.RemoveAll
         
    Next winnerKey
               
End Sub

---

Function for generating class objects:

Function GetSellerPresentsObject(slrname As String, prsnts As Dictionary, flevel As Long)
    Dim obj As New Class2
    obj.SellerName = slrname
    obj.Presents = prsnts
    obj.FillLevel = flevel
    Set GetSellerPresentsObject = obj
End Function

---

For some reason mistake:

Code seems correct, but have difficulty in this error: Object varible or With block variable not set

Answer 1

In addition to not using the Set keyword, you

• refer to the wrong dictionary in your loop

• EachPresentDict.RemoveAll is messing up what is stored in your obj

• I'm not sure what values you expect in your obj so you may have to adjust the loop

Edit:
To show a distribution method where presents are picked in order of their entry in the presents dictionary, until the funds run out, the code has been modified to implement that logic

Try this modification:

Option Explicit

Sub DistributePrize()
    
    Dim winnersList As New Scripting.Dictionary
    Dim presentsList As New Scripting.Dictionary
        
    'some test data for Winners Dictionary
    winnersList.Add "Winner1", 25000
    winnersList.Add "Winner2", 15000
    winnersList.Add "Winner3", 5000
    
    'some test data for Presents Dictionary
    presentsList.Add "Present1", 25000
    presentsList.Add "Present2", 10000
    presentsList.Add "Present3", 3000
    presentsList.Add "Present4", 2000
    
    'Just sorting presentsList in xlDescending order.
    'Set presentsList = SortDictionaryByValue(presentsList, xlDescending)
            
    Dim winnerKey, presentsKey As Variant
    Dim objectsCollection As New Collection
    Dim EachPresentDict As New Scripting.Dictionary
    
    Dim totalSum As Long
    
    For Each winnerKey In winnersList
    Set EachPresentDict = New Scripting.Dictionary
    totalSum = 0
        For Each presentsKey In presentsList
            If totalSum + presentsList(presentsKey) <= winnersList(winnerKey) Then
                EachPresentDict.Add presentsKey, presentsList(presentsKey)
                totalSum = totalSum + presentsList(presentsKey)
            End If
         Next presentsKey
            
         objectsCollection.Add GetSellerPresentsObject(CStr(winnerKey), EachPresentDict, CLng(totalSum))
         
    Next winnerKey
               
End Sub

Function GetSellerPresentsObject(slrname As String, prsnts As Dictionary, flevel As Long)
    Dim obj As New Class2
    obj.SellerName = slrname
    Set obj.Presents = prsnts
    obj.FillLevel = flevel
    Set GetSellerPresentsObject = obj
End Function

If you prefer using the RemoveAll method, put it just after the start of your Each WinnerKey loop