Including Date Worked in Range D:D when Value in R:R Changes

[Sharonca]

Hello,

I have the following Macro that generates an email when the user changes the value in a cell in column R to Approved.. I would like to include the Date Worked (in column D) when the value changes to Approved in the body of the email. So if R3 changes to Approved the statement "Date Worked value (value in Cell D3)" is included in the body of the email. This would only be for the 2nd level email.

I am kind of stuck on how to work the Range designation.

My code is as follows.

Private Sub Worksheet_Change(ByVal Target As Range)


'BBU
Dim xMailBody As String


On Error Resume Next
    
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.EnableEvents = False


If Target.Cells.CountLarge > 1 Then Exit Sub


If Not Intersect(Target, Range("R:R")) Is Nothing Then


    If Target.Value = "Approved" Then
            xMailBody = "Cell(s) " & Target.Address(False, False) & _
            " were modified on " & _
            Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _
            " by " & Environ$("username") & vbNewLine & vbNewLine & "Date worked"




        With CreateObject("outlook.application").CreateItem(0)
             .To = "xxxx"
             .Subject = "BBU Invoice Approved - Level 1"
             .Body = xMailBody
             .display
        End With
        
            Columns.AutoFit
            Cells(Target.Row, "T").Value = UCase(Split(Application.UserName, ",")(0))
            Cells(Target.Row, "S").Value = Now
        End If
        
 '2nd level
ElseIf Not Intersect(Target, Range("V:V")) Is Nothing Then
 
    If Target.Value = "Approved" Then
      
            xMailBody = "Cell(s) " & Target.Address(False, False) & _
            " were modified on " & _
            Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _
            " by " & Environ$("username")
    


        With CreateObject("outlook.application").CreateItem(0)
             .To = "xxx"
             .Subject = "BBU Invoice Final Approved"
             .Body = xMailBody
             .display
        End With
        
        Columns.AutoFit
            Cells(Target.Row, "X").Value = UCase(Split(Application.UserName, ",")(0))
            Cells(Target.Row, "W").Value = Now
        End If


End If
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    
End Sub