Dynamically loop over 2 columns in vba

Question

I have in a column a list of email addresses and another column with keys (unique ID), like this :

What I am trying to do is to send an email to each user with the keys in the email. I manage to send emails, but for the same user like toto@example, it will send 5 emails with each the key corresponding.

However i'd like to group all the keys from the user, so something like concatanate the keys in the same string. As I call a function to send email like this : Call sendEmail(object, email, body)

I first tried to loop and compare each value with a Do while, but I completly lost in the loop:

    Sub sendEmailPart()

    Sheets(4).Activate
    Range("B1").Select
    Dim i, cpt As Integer
    Dim clefConcat As String
    i = 1
    cpt = 1
    clefConcat = ""
    Dim email, body, objectAs String
    Do Until IsEmpty(ActiveCell)
        sujet = Range("A" & i).Value
        email = Range("B" & i).Value
        Do While email = ActiveCell.Value
            clefConcat = clefConcat & " " & Range("C" & cpt)
            cpt = cpt + 1
            ActiveCell.Offset(1, 0).Select
        Loop
        i = i + 1
        contenu = clefConcat 
        Call sendEmail(object, email, body)
        ActiveCell.Offset(1, 0).Select
        
    Loop
End Sub

I want to learn from this, so, if possible, explain to me what I'm doing wrong here, or if my approach is lacking insight.

user_5772095 · Answer

I always find it easiest to use the Scripting.Dictionary object for such a thing.

Make a reference to that object in your references for the given VBA project.

... and then add this code to your module and run it. You'll see it in a working example.

Public Sub SendEmailPart()
    Dim objDict As New Scripting.Dictionary
    Dim lngRow As Long, strEmail As String, strSubject As String, i As Long
    
    ' Change the sheet to the sheet object that matches your workbook.
    With Sheet1
        For lngRow = 1 To .Rows.Count
            strEmail = .Cells(lngRow, 1)
            strSubject = .Cells(lngRow, 2)
        
            If strEmail = "" Then Exit For
        
            If Not objDict.Exists(strEmail) Then
                objDict.Add strEmail, strSubject
            Else
                objDict.Item(strEmail) = objDict.Item(strEmail) & ", " & strSubject
            End If
        Next
    End With
    
    For i = 0 To objDict.Count - 1
        Debug.Print objDict.Keys(i) & " = " & objDict.Items(i)
    Next
End Sub

You should be able to adapt your project to that.

Dynamically loop over 2 columns in vba

1 Answers