Send email to the based on the corresponding cell value

[nss280]

Hi All,
Struggling to find an answer for this. I am trying to send an email ( cell value) based on the cell value update. I have status in "U" column and emails in "AR" column. I am trying to send an email to the corresponding value in "AR" when the status changes to "Complete" in "U" column within the same row. Each cell in AR may possibly have different emails.
Currently I am able to send email only to a value in one cell.

Thanks in advance for reading through my post and your assistance.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2017/9/12
    Dim xRgSel As Range
    Dim xOutApp As Object
    Dim xMailItem As Object
    Dim xMailBody As String
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set xRg = Range("U1:U1500")
    Set xRgSel = Intersect(Target, xRg)
    ActiveWorkbook.Save
    If Not xRgSel Is Nothing Then
        Set xOutApp = CreateObject("Outlook.Application")
        Set xMailItem = xOutApp.CreateItem(0)
        xMailBody = "Cell(s) " & xRgSel.Address(False, False) & _
            " in the worksheet '" & Me.Name & "' were modified on " & _
            Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _
            " by " & Environ$("username") & "."

        With xMailItem
            '.To = "Email Address"
            .To = Range("AR93").Value
            '.Subject = "Worksheet modified in " & ThisWorkbook.FullName
            .Subject = Range("AQ93").Value & " ready to execute "
            .Body = xMailBody
            .Attachments.Add (ThisWorkbook.FullName)
            .Display
        End With
        Set xRgSel = Nothing
        Set xOutApp = Nothing
        Set xMailItem = Nothing
    End If
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

 

[nss280]

Hi All,
Struggling to find an answer for this. I am trying to send an email ( cell value) based on the cell value update. I have status in "U" column and emails in "AR" column. I am trying to send an email to the corresponding value in "AR" when the status changes to "Complete" in "U" column within the same row. Each cell in AR may possibly have different emails.
Currently I am able to send email only to a value in one cell.

Thanks in advance for reading through my post and your assistance.

Private Sub Worksheet_Change(ByVal Target As Range)
'Updated by Extendoffice 2017/9/12
    Dim xRgSel As Range
    Dim xOutApp As Object
    Dim xMailItem As Object
    Dim xMailBody As String
    On Error Resume Next
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set xRg = Range("U1:U1500")
    Set xRgSel = Intersect(Target, xRg)
    ActiveWorkbook.Save
    If Not xRgSel Is Nothing Then
        Set xOutApp = CreateObject("Outlook.Application")
        Set xMailItem = xOutApp.CreateItem(0)
        xMailBody = "Cell(s) " & xRgSel.Address(False, False) & _
            " in the worksheet '" & Me.Name & "' were modified on " & _
            Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _
            " by " & Environ$("username") & "."

        With xMailItem
            '.To = "Email Address"
            .To = Range("AR93").Value
            '.Subject = "Worksheet modified in " & ThisWorkbook.FullName
            .Subject = Range("AQ93").Value & " ready to execute "
            .Body = xMailBody
            .Attachments.Add (ThisWorkbook.FullName)
            .Display
        End With
        Set xRgSel = Nothing
        Set xOutApp = Nothing
        Set xMailItem = Nothing
    End If
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

Same issue with the .Subject as well in the xMailItem.

If U62 changes to "Complete" I am trying to get .To = Range ("AR62").Value and .Subject =Range("AQ62"). Value.
If U107 changes to "Complete" I am trying to get .To = Range ("AR107").Value and .Subject =Range("AQ107"). Value.

The excel has 1500 rows.