Results 1 to 2 of 2

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

  1. #1
    Junior Member
    Join Date
    Aug 2012
    Posts
    1
    Rep Power
    0

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

    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!

    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgykemWTw-fGoPwu8E14AaABAg.9iECYNx-n4U9iK75iCEaGN
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgykemWTw-fGoPwu8E14AaABAg.9iECYNx-n4U9iK7XF33njy
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=Ugy_1xkcndYdzUapw-J4AaABAg.9iGOq_leF_E9iKCSgpAqA1
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=Ugy_1xkcndYdzUapw-J4AaABAg.9iGOq_leF_E9iKCy--3x8E
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgwNaJiNATXshvJ0Zz94AaABAg. 9iEktVkTAHk9iF9_pdshr6
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgykemWTw-fGoPwu8E14AaABAg.9iECYNx-n4U9iFAZq-JEZ-
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgxV2r7KQnuAyZVLHH54AaABAg. 9iDVgy6wzct9iFBxma9zXI
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=Ugx12mI-a39T41NaZ8F4AaABAg.9iDQqIP56NV9iFD0AkeeJG
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgwnYuSngiuYaUhEMWN4AaABAg. 9iDQN7TORHv9iFGQQ5z_3f
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgwJ3yzdk_EE98dndmt4AaABAg. 9iDLC2uEPRW9iFGvgk11nH
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgyDWAVqCa4yMot463x4AaABAg. 9iH3wvUZj3n9iHnpOxOeXa
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=UgwvLFdMEAba5rLHIz94AaABAg. 9iGReNGzP4v9iHoeaCpTG8
    https://www.youtube.com/watch?v=ITI1HaFeq_g&lc=Ugy_1xkcndYdzUapw-J4AaABAg.9iGOq_leF_E9iHpsWCdJ5I
    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    Last edited by DocAElstein; 09-22-2023 at 04:11 PM.

  2. #2
    Administrator Excel Fox's Avatar
    Join Date
    Mar 2011
    Posts
    1,402
    Rep Power
    10
    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
    A dream is not something you see when you are asleep, but something you strive for when you are awake.

    It's usually a bad idea to say that something can't be done.

    The difference between dream and aim, is that one requires soundless sleep to see and the other requires sleepless efforts to achieve

    Join us at Facebook

Similar Threads

  1. Replies: 15
    Last Post: 06-04-2013, 07:02 PM
  2. Replies: 2
    Last Post: 05-30-2013, 07:28 PM
  3. Replies: 8
    Last Post: 04-16-2013, 02:04 PM
  4. Replies: 2
    Last Post: 01-24-2013, 09:03 PM
  5. Get last Filled Cell address in a Range.
    By Rajan_Verma in forum Rajan Verma's Corner
    Replies: 3
    Last Post: 03-24-2012, 01:08 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •