Automatically send an email if a specific cell value exists; include adjacent value in body

Question

I have been working on an xlsm sheet that as part of its function produces a result of "No Data" in column J if it cannot find a match in its other data files.

What I need is to have Excel loop through Column J and automatically generate an email if the value in J = "No Data" and in the body of the email I need to include the cell offset value from Column F of the same Row.

I have used the Ron De Bruin code and modified it with Looping code from a similar function elsewhere in the project.

I cannot get this to function and could use some direction. Here is the code I have up to this point

Private Sub EmailIC()

'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'This macro adapted from: http://www.rondebruin.nl/win/s1/outlook/bmail4.htm

    Dim OutApp As Outlook.Application
    Dim OutMail As Outlook.MailItem
    Dim wbXLoc As String, wbX As Workbook, wsX As Worksheet, wsXName As String
    Dim Xlr As Long
    Dim rngX As Range, cel As Range, order As Range

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(olMailItem)

    wbXLoc = "C:\Users\Cole\Downloads\Dads Work\XDock\AutoXrpt.xlsm" 
    wsXName = "AutoX"

    Set wsX = wbX.Sheets(wsXName)

    'Loop through Column J to determine if = "No Data"

    With wbX
         Xlr = .Sheets("AutoX").Cells(Rows.Count, 1).End(xlUp).Row
         Set rngX = wbX.Sheets("AutoX").Range("J2:J" & Xlr)
    End With

 'do the loop and find
    For Each cel In rngX
        If cel.Value = "No Data" Then
            On Error Resume Next
               With OutMail
                   .to = "robe******@msn.com"
                   .CC = ""
                   .BCC = ""
                   .Subject = "Need Pick Face please!"
                   .Body = rngX.cel.Offset(0, -4).Value
                   .Send
               End With
            On Error GoTo 0

         Set OutMail = Nothing
         Set OutApp = Nothing
       End If
    Next cel
End Sub

Answer 1

What Om3r has looks good, they pointed out that you needed to set the wsX variable to an actual sheet before being able to set the range variable rngX. This might be why your loop might not have worked. Hard to say without knowing what error was thrown when you ran your code.

Also, be sure to have the object library for Outlook enabled. Check under the ribbon Tools>References and make sure your Outlook Library is listed.

Answer 2

little confused to what you doing, but this should get you started-

Option Explicit
Private Sub EmailIC()

'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'This macro adapted from: http://www.rondebruin.nl/win/s1/outlook/bmail4.htm

    Dim OutApp As Object ' Outlook.Application
    Dim OutMail As Outlook.MailItem
'    Dim wbXLoc As String
'    Dim wbX As Workbook
    Dim wsX As Worksheet
'    Dim wsXName As String
'    Dim Xlr As Long
    Dim rngX As Range
    Dim cel As Range
'    Dim order As Range

    Set OutApp = CreateObject("Outlook.Application")

'    wbXLoc = "C:\Users\0m3r\Desktop\Macro-VBA\0m3r.xlsm"
'    wsXName = "Sheet2"


    Set wsX = ThisWorkbook.Worksheets("AutoX")
'    wsXName = "AutoX"
'    Set wsX = wbX.Sheets(wsXName)

    'Loop through Column J to determine if = "No Data"

'    With wbX
'         Xlr = .Sheets("AutoX").Cells(Rows.Count, 1).End(xlUp).Row
'         Set rngX = wbX.Sheets("AutoX").Range("J2:J" & Xlr)
'    End With

    Set rngX = wsX.Range("J2", Range("J65536").End(xlUp))

    'do the loop and find
    For Each cel In rngX
        If cel.Value = "No Data" Then

        Set OutMail = OutApp.CreateItem(olMailItem)

            Debug.Print cel.Value
            Debug.Print cel.Offset(0, -4).Value

'            On Error Resume Next
               With OutMail
                   .To = "robe******@msn.com"
                   .CC = ""
                   .BCC = ""
                   .Subject = "Need Pick Face please!"
                   .Body = cel.Offset(0, -4).Value
                   .Display
               End With
            On Error GoTo 0

       End If
    Next cel

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

Answer 3

you may want to try this (commented) code:

Option Explicit

Private Sub EmailIC()

'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'This macro adapted from: http://www.rondebruin.nl/win/s1/outlook/bmail4.htm

    Dim OutApp As Outlook.Application
    Dim wbXLoc As String, wsXName As String
    Dim cel As Range, order As Range

    Set OutApp = CreateObject("Outlook.Application")
    wbXLoc = "C:\Users\Cole\Downloads\Dads Work\XDock\AutoXrpt.xlsm"
    wsXName = "AutoX"

    With Workbooks.Open(wbXLoc).Worksheets(wsXName) '<-- open 'wbXLoc' workbook and reference its 'wsXName' worksheet
        With .Range("J1", .Cells(.Rows.Count, "J").End(xlUp)) '<--| reference its column "J" cells from row 1 down to its last non empty cell
            .AutoFilter field:=1, Criteria1:="No Data" '<--| filter referenced cells with "No Data" criteria
            If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<--| if any cell ha been filtered othre than the header (in row 1)
                For Each cel In .Resize(.Rows.Count - 1).Offset(1).SpecialCells(XlCellType.xlCellTypeVisible) '<-- loop through filtered cells (skippin header in row 1)
                    With OutApp.CreateItem(olMailItem) '<-- cerate and reference a new mail item
                        .to = "robe******@msn.com"
                        .CC = ""
                        .BCC = ""
                        .Subject = "Need Pick Face please!"
                        .Body = cel.Offset(0, -4).Value
                        .Send
                    End With
                Next cel
            End If
        End With
    End With
    ActiveWorkbook.Close False '<--| close opened workbook discarding changes (i.e. autofiltering)

    OutApp.Quit '<-- quit Outlook
    Set OutApp = Nothing
End Sub