Sending Email Based on Cell Value within a Loop

I have a sample sheet

I have a module that runs through the list in a loop within another loop, checking for duplicate names and then grouping the names together to send an email with an attachment based on Column D (Division).

Sample 4 would get one email with 3 attachments.

I have been asked to build in the ability to exclude people based on a value (I chose yes or no, column C) before running the module.

Reason being that if the list is long (over 1000 names) to set it before generating the emails. I would build in a trigger to set that value, but it is apparently an arbitrary decision made by the senders in a dept.

I have tried to build an IF statement into the loop as shown below but it is as if the If statement is coming out as not being true (I stepped through).
Which means all the With Outmail objects will not work.

I was able to get it to work by using the if statement with a for/next setup on its own (no loops), but cannot get it to work with the loop, which is the more important piece.

Here is the main piece of code. The main loop and then the if statement to account for the yes or no values:

Do While r <= rng.Rows.Count
If rng.Cells(r, 3).Value Like "?*@?*.?*" And LCase(rng.Cells(r, 3)) = "yes" Then     
    Set OutMail = OutApp.CreateItem(0)
End If

And here is the full sub:

Sub EmailDivisions()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell, lookrng As Range
    Dim strDir As String
    Dim strFilename As String
    Dim sigString As String
    Dim strBody As String
    Dim strName As Variant
    Dim strName1 As Variant
    Dim strDept As Variant
    Dim strName2 As String
    Dim strName3 As Variant    
    
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    
    sigString = Environ("appdata") & _
                "\Microsoft\Signatures\Divisions.htm"
                              
    If Dir(sigString) <> "" Then
        signature = GetBoiler(sigString)
    Else
        signature = ""
    End If
        
    Set rng = ActiveSheet.UsedRange

    r = 2
        
    Do While r <= rng.Rows.Count
        If rng.Cells(r, 3).Value Like "?*@?*.?*" And LCase(rng.Cells(r, 3)) = "yes" Then
         
            Set OutMail = OutApp.CreateItem(0)
        End If
         
        Set strName = rng.Cells(r, 1)
        Set strDept = rng.Cells(r, 4)
        strName2 = Left(strName, InStr(strName & " ", " ") - 1)

        With OutMail
            strFilename = Dir("\\Divisons\1a*" & strDept & "*")
            .SentOnBehalfOfName = "[email protected]"
            .To = rng.Cells(r, 2).Value
            .Subject = "Monthly Divisional Report for " & strDept
            .HTMLBody = "<Font Face=calibri>" & "Dear " & strName2 & ",<br><br>" & signature
            .Attachments.Add strDir & strFilename
                            
            'See if the next row is for the same sender.  If so, process that
            'row as well.  And then keep doing it until no more rows match
            Do While rng.Cells(r, 2).Value = rng.Cells(r + 1, 2)
                r = r + 1
                Set strDept = rng.Cells(r, 4)
                strfilename1 = Dir("\\Divisions\1a*" & strDept & "*")
                .Subject = "Monthly Divisional Report for Your Departments"
                .Attachments.Add strDir & strfilename1
            Loop
            .Display

        End With
        Set OutMail = Nothing
        r = r + 1
    Loop
    Set OutApp = Nothing
          
End Sub

Function GetBoiler(ByVal sFile As String) As String
    Dim FSO As Object
    Dim ts As Object
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set ts = FSO.GetFile(sFile).OpenAsTextStream(1, -2)
    GetBoiler = ts.ReadAll
    ts.Close
End Function