Nested Dictionary Question

[gs7592]

Hi - I'm attempting to create a code which I can create an email body based on 3 criteria - whether a column is checked to send an email (aCell.offset(0,4)) the list of emails (aCell.offset(0,3)) (so only one email sent per email address) and a list of questions (aCell.offset(0,1)) based on a name(aCell). So, my columns are: Name, Question, Email, where there may be duplicate names and emails. So far I have been able to create a dictionary that stores values for each email address to create the email body (below code) but am having difficulties adding in another criteria so that the names don't show up twice. For example, right now, my code returns the following sequence: A1, A2, A3, B1, B2, (where A and B are names and the numbers are questions), and I am trying to get it to return the following: A 1, 2, 3, B 1, 2. I've been told the answer is creating a nested dictionary, but can't seem to figure out how to do so. Hope that makes sense and someone can help out!! Thanks!!

Sub Send_Email_Using_VBA()
Dim rng As Range
Dim aCell As Range
Set rng = Range("b3:b2000")
Set dict = CreateObject("Scripting.Dictionary")
'Collect data
For Each aCell In Range("b3", Range("b3").End(xlDown))
If aCell.Offset(0, 4).Value = "x" Then
Dim key, val
key = aCell.Offset(0, 3)
If Not dict.Exists(key) Then
val = "" & aCell & "" & Space(1) & "" & aCell.Offset(0, 2) & "" & "
" & aCell.Offset(0, 1)
dict.Add key, val
Else
val = "" & aCell & "" & Space(1) & "" & aCell.Offset(0, 2) & "" & "
" & aCell.Offset(0, 1)
Dim existing As String
existing = dict(key)
existing = existing & "

" & val
dict(key) = existing
End If
debugs:
If Err.Description <> "" Then MsgBox Err.Description
End If
Next

'Send data
For Each strKey In dict.Keys
Dim emailBody As String
emailBody = dict(strKey)
'Send the email

Dim Email_Subject, Email_Send_From, Email_Send_To, Email_Cc, Email_Bcc, Email_Body As String
Dim Mail_Object, Mail_Single As Variant
Email_Subject = "Questions"
Email_Send_From = "L3"
Email_Send_To = strKey
Email_Cc = ""
Email_Bcc = ""
Email_Body = Range("L3") & emailBody

On Error GoTo debugs
Set Mail_Object = CreateObject("Outlook.Application")
Set Mail_Single = Mail_Object.CreateItem(0)
With Mail_Single
.Subject = Email_Subject
.to = Email_Send_To
.Cc = Email_Cc
.BCC = Email_Bcc
.HTMLBody = Email_Body
.send
End With
Next
MsgBox ("done")
End Sub

 

[Jerry Sullivan]

Welcome to MrExcel,

I think of a "nested" dictionary as being a dictionary contained inside another dictionary.
From the description of your task, you are wanting to use the dictionary keys to store unique names and use the key items to store a collection of questions.

In Post #2 of this thread, Xenou provides an example that you could adapt for your application (his uses comma-delimited strings, which you can change to space character delimited strings).

https://www.mrexcel.com/forum/excel-questions/648112-position-array-best-way.html