Change in One Cell that Prompts Email to Address in Adjacent Cell

**jtroi89** · 08-21-2012, 06:42 PM

Hello! I'm fairly new to VBA and in need of some guidance...

What I'm trying to do is if I make a change in any cell in column P for example, it sends an email to the address listed in the corresponding row of Column B, with the change that I made in column P of the corresponding row included in the body of the email. I know there's a fairly simple way of doing this, but I haven't quite gotten my finger on it. I'm running Office 2007.

I know I start with a worksheet change event, and have it search for a change that's a number (the content I'm putting in column P is a date). Here's what I have so far:

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub
    If Not Applicaion.Intersect(Range("P:P"), Target) Is Nothing Then
       If IsNumeric(Target.Cells) And Target.Cells > 1 Then


'Some stuff needs to go here!!! ???

'Send the email using outlook:

Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String


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


    strbody = "body goes here" 'Would like to put a message here with the changed value included in the text


   On Error Resume Next
    With OutMail
        .To = "blank@email.com" 'email from corresponding row goes here
        .CC = ""
        .BCC = ""
        .Subject = "Subject"
        .Body = strbody
        'You can add a file like this
        '.Attachments.Add ("C:\")
        .Display   'or use .Send
    End With
    On Error GoTo 0


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

Help please! Thanks in advance!

**Excel Fox** · 08-21-2012, 07:36 PM

Code:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Application.Intersect(Range("P:P"), Target) Is Nothing Then
        Set OutApp = CreateObject("Outlook.Application")
        Set OutMail = OutApp.CreateItem(0)
        strbody = "The changed value is " & Target.Value 'Would like to put a message here with the changed value included in the text
    
        On Error Resume Next
        With OutMail
            .To = Range("B" & Target.Row).Value 'email from corresponding row goes here
            .CC = ""
            .BCC = ""
            .Subject = "Subject"
            .Body = strbody
            'You can add a file like this
            '.Attachments.Add ("C:\")
            .Display   'or use .Send
        End With
        On Error GoTo 0
        Set OutMail = Nothing
        Set OutApp = Nothing
    End If
    
End Sub