Issues with looping through multiple columns in Excel VBA

Question

My VBA code loops through Column "I" with people's names and creates a list of emails. In email body there's a list of rows for each person from columns B, C, G, I. Pretty straightforward, however I encounter an issue with the latter. It only takes the first row for each person, i.e. doesn't loop through the list to get all of the rows for one recipient. I have a feeling this somehow stops it from looping further:

         If InStr(1, PriorRecipients, EmailAddr) <> 0 Then
             GoTo NextRecipient
         End If

But not sure how to implement a second loop??

Full code:

  Sub SendEmail2()

    Dim OutlookApp
    Dim MItem
    Dim cell As Range
    Dim Subj As String
    Dim EmailAddr As String
    Dim Recipient As String
    Dim Msg As String
    Dim Projects As String
    Dim ProjectsMsg As String
    Dim bSendMail As Boolean


    'Create Outlook object
    Set OutlookApp = CreateObject("Outlook.Application")
    Set MItem = OutlookApp.CreateItem(0)
    'Loop through the rows
    For Each cell In Columns("I").Cells.SpecialCells(xlCellTypeVisible)
     If cell.Value <> "" And _
           (Cells(cell.Row, "L").Value) = "No" And (Cells(cell.Row, "K").Value) <> "Yes" Then
            'first build email address
            EmailAddr = LCase$(Replace(cell.Value, " ", ".")) & "@company.com"
            'then check if it is in Recipient List build, if not, add it, otherwise ignore
            If InStr(1, Recipient, EmailAddr) = 0 Then Recipient = Recipient & ";" & EmailAddr

             Projects = vbCrLf & "Document: " & Cells(cell.Row, "B").Value & "; " & Cells(cell.Row, "C").Value & "; " & "Rev " & Cells(cell.Row, "G").Value & "; " & Cells(cell.Row, "I").Value
             If InStr(1, ProjectsMsg, Projects) = 0 Then ProjectsMsg = ProjectsMsg & Projects & vbCrLf

        If InStr(1, Recipient, cell.Offset(1).Value) <> 0 Then
          bSendMail = True
          Recipient = Recipient & ";" & cell.Offset(1)
            Else
           bSendMail = False
        End If

End If
Next
    Msg = "You have the following outstanding documents to be reviewed at: "& ProjectsMsg
    Subj = "Outstanding Documents to be Reviewed"
    'Create Mail Item and view before sending
  If bSendMail Then Set MItem = OutlookApp.CreateItem(olMailItem)
    With MItem
        .To = Recipient 'full recipient list
        .Subject = Subj
        .Body = Msg
        .display

    End With


End Sub

Try assigning PriorRecipients before the If statement and then reassigning afterwards with another variable. It doesn't seem as if there is a string value for PriorRecipients on the first loop, which would cause an error. — Dan
– Dan, Commented Feb 12, 2016 at 17:55
@Dan Do you mean just a simple PriorRecipients = "" before If and re-assigning with a new variable after if? is that instead of PriorRecipients = PriorRecipients & ";" & EmailAddr ? — warfo09
– warfo09, Commented Feb 12, 2016 at 18:34
Yea, if you step through your loop you can see what value it's using for priorrecipient on the first if statement. If it has an empty value, you'll need to assign it before the if statement to have it operate correctly. — Dan
– Dan, Commented Feb 12, 2016 at 19:40

Scott Holtzman · Accepted Answer · 2016-02-12 18:53:49Z

1

Change this block of code:

  If InStr(1, PriorRecipients, EmailAddr) <> 0 Then
     GoTo NextRecipient
  End If

  PriorRecipients = PriorRecipients & ";" & EmailAddr

To this

If InStr(1, PriorRecipients, EmailAddr) = 0 Then
    PriorRecipients = PriorRecipients & ";" & EmailAddr
End If

'checks if it's the last email for that unique person and if so,
`it's done looping rows for that email and the email is good to send
If Instr(1, PriorRecipients, cell.Offset(1).Value) <> 0 Then 
    Dim bSendMail as Boolean
    bSendMail = True
    PriorRecipients = PriorRecipients & ";" & cell.Offset(1)
Else
    bSendMail = False
End If

If bSendMail Then 
   Set MItem = OutlookApp.CreateItem(olMailItem)
   ' rest of code to send mail ... 
End If

edited Feb 12, 2016 at 18:53

answered Feb 12, 2016 at 17:06

Scott Holtzman

27.3k5 gold badges42 silver badges76 bronze badges

Sign up to request clarification or add additional context in comments.

4 Comments

warfo09 Over a year ago

Thanks for your reply. I've tried this method actually. This however makes Outlook create a new window for each email and report (and eventually crash the computer :) ).

warfo09 Over a year ago

Here's a worksheet to illustrate my problem... dropbox.com/s/l4w7tkrmw563i0u/Test%20Review.xlsm?dl=0

Scott Holtzman Over a year ago

@warfo09 - I cannot view your spreadsheet where I am right now. Do you want 1 email for each unique email address? I assume so by your code, so see my edit. If that's not what you need let me know.

warfo09 Over a year ago

Scott, I tried doing it differently over the weekend using your suggestions. Either way it didn't work. This is the latest I have - please see my edited post - for some reason I still get 1 email with all the recipients? I gave up on my trial and error method in the end... :-(

Collectives™ on Stack Overflow

Issues with looping through multiple columns in Excel VBA

1 Answer 1

4 Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

4 Comments

Your Answer

Sign up or log in

Post as a guest

Related