VBA Code to Send Mail to skip blank cells

[Ben AFF]

Hi All,

Appreciate if you can help me with the following.

I have a macro code to send emails to all selected rows in columns E&F of an spreadsheet.
When any rows of E&F columns are selected the macro will look in column M & N for the .To and .CC addresses and generate an email.
This part is working well.
The problem is that the macro will generate an error if there is no mail address or blank value in column M.
I want to modify the code so when there is no email address the code stops trying to send a mail and generate an error.
Please can you help me? Thank you.

I past below the macro code.

Sub ExcelToOutlookSR()
Dim mApp As Object
Dim mMail As Object
Dim SendToMail As String
Dim MailSubject As String
Dim mMailBody As String
Dim r As Range, n As Long
Dim d As Object, f As Object
Dim tx As String
Dim x, ary, g

UserResponse = MsgBox("This will send e-mails for selected cells, are you sure?", vbYesNo + vbExclamation, "Send Mail?")
  
'If No exit sub
   If UserResponse = vbNo Then
    Exit Sub
   End If

If Not Intersect(Selection, Range("E:F")) Is Nothing And Intersect(Selection, Range("G:XFD")) Is Nothing Then

    n = Range("E" & Rows.Count).End(xlUp).Row 'get last row with data in col E
    If Not Intersect(Selection, Range("E2:E" & n)) Is Nothing Then
        Set d = CreateObject("scripting.dictionary"):        d.CompareMode = vbTextCompare
        Set f = CreateObject("scripting.dictionary"):        f.CompareMode = vbTextCompare
        
        For Each r In Intersect(Selection, Range("E2:E" & n))
            f(r.Value) = Empty
        Next
        
        For Each r In Range("E2:E" & n)
            tx = r.Value
            If f.Exists(tx) Then
                If Not d.Exists(tx) Then
                    d(tx) = r.Row
                Else
                    d(tx) = d(tx) & " " & r.Row
                End If
            End If
        Next
       
        For Each x In d
            ary = Split(d.Item(x), " ")
            SendToMail = Range("M" & ary(0))
            CopyToMail = Range("N" & ary(0))
            MailSubject = Range("K" & ary(0))
            tx = ""
            For Each g In ary
                tx = tx & vbLf & Range("L" & g)
            Next
            mMailBody = Mid(tx, 2)
'            Debug.Print mMailBody
            Set mApp = CreateObject("Outlook.Application")
            Set mMail = mApp.CreateItem(0)
            With mMail
                .To = SendToMail
                .CC = CopyToMail
                .Subject = MailSubject
                .Body = "Dear " 
                .Send
                                  
            Selection.Copy
            ThisWorkbook.Worksheets("Log").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            End With
        Next
        MsgBox "@mails are sent"
    Else
        MsgBox "Please, select cells with data in column E&F only."
    End If
Else
    MsgBox "Please, select cells with data in column E&F only."
End If

End Sub

 

[Micron]

Should work if you validate SendToMail within an IF block? Maybe

If SendToMail <> "" Then
    With mMail
        .To = SendToMail
        etc.
    End With
End If

If not there then not sure. That looks rather complicated for what it does.