Automatic Email not working properly

[Damian37]

I've written something to try and get automatic emails to be sent out based on whether there was information within a cell or not. I have two "asks": How would I code to review the data within a worksheet, and no matter how many records meet the criteria (POC information missing), only one email will be sent to recipients within two columns (19, 21) for that Region? The below image shows the missing POC name and email information needed for other automated reports:

Here's the code I've written. Instead of creating an email, when I click the send email button it directs me to the AllData worksheet. Stumped!!!

Private Sub CommandButton2_Click()

Dim OutLookApp As Object

  Dim OutLookMailItem As Object
  Dim iCounter As Integer
  Dim MailDest As String
  Dim MailDest2 As String
 
  Set OutLookApp = CreateObject("Outlook.application")
  Set OutLookMailItem = OutLookApp.CreateItem(0)
 

  Worksheets("AllData").Activate

 
  For iCounter = 2 To WorksheetFunction.CountA(Columns(28))
    
     MailDest = ""
    
     If Len(Cells(iCounter, 28).Offset(0, -1)) > 0 Then
     If MailDest = "" And Cells(iCounter, 7).Offset(0, -1) = "Open" Then
            
     Set OutLookMailItem = OutLookApp.CreateItem(0)
     With OutLookMailItem
    
     MailDest = Cells(iCounter, 19).Value
     MailDest2 = Cells(iCounter, 21).Value
    
        .To = MailDest
        .CC = MailDest2
        .BCC = 
        .Subject = "Missing store POC"
        .HTMLBody = "To Whom It May Concern,<p>" _
            & "Please be advised the store POC information is currently missing for stores in your area. " _
            & "If available, please provide current store POC information in order" _
            & "for automatic emails to be sent to the correct store POC.<p>" _
            & "Please note: If the store POC field remains empty, all emails will be" _
            & "directed to ROMs and FMMs.<p>" _
            
    
    .Display
    '.Send
    End With
        .Attachments.Add ActiveWorksheet.FullName
        
        For Each objOutlookRecip In .Recipients
            objOutlookRecip.Resolve
            If Not objOutlookRecip.Resolve Then
            Exit Sub
        End If
    
      
        Next iCounter
    
  Set OutLookMailItem = Nothing
  Set OutLookApp = Nothing

End Sub

All help is greatly appreciated! Thank you so much!
D