Created Fields and Auto Emailing

I have a contacts spreadsheet that I would like to do a couple of things:

1 When a date is added to a LastContacted field, I want to populate a new field for a 30 day follow up.
2 When the follow up date is today, I would like to send an automated email reminder to the correct person for follow up.

Can anyone help me with the coding for this?

Thanks in advance!

Amy

Post a sample of your workbook with 10 rows of example data. DO NOT post an image of your worksheet ... we can't work with an image. Thanks.

Please see attached. Thanks!

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    Dim cell As Range
    Dim OutApp As Object
    Dim OutMail As Object
    Dim emailBody As String
    Dim currentRow As Range
    Dim emailList As Collection
    Dim emailAddress As Variant
    
    Set rng = Intersect(Target, Me.Columns("O").SpecialCells(xlCellTypeConstants))
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    On Error Resume Next
    
    If Not rng Is Nothing Then
        Set emailList = New Collection
        
        For Each cell In rng
            If IsDate(cell.Value) Then
                cell.Offset(0, 1).Value = DateAdd("d", 30, Date)
                emailAddress = cell.Offset(0, -8).Value
                
                If Not IsEmpty(emailAddress) Then
                    emailList.Add emailAddress
                End If
            End If
        Next cell
        
        If emailList.Count > 0 Then
            Set OutApp = CreateObject("Outlook.Application")
            
            With Sheets("Sheet1")
                For Each emailAddress In emailList
                    Set OutMail = OutApp.CreateItem(0)
                    Set currentRow = .Rows(ActiveCell.Row)
                    emailBody = ""
                    
                    
                    For Each cell In currentRow.Cells
                        emailBody = emailBody & cell.Value & "  "
                    Next cell
                    
                    With OutMail
                        .To = emailAddress
                        .Subject = "Date Entry Notification"
                        .Body = emailBody
                        '.Send
                        .Display
                    End With
                    
                    Set OutMail = Nothing
                Next emailAddress
            End With
            Set OutApp = Nothing
        End If
    End If
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub