Issues with looping through multiple columns in Excel VBA - 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

Answer 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