Email notification

Hello Kid_K,

Here is the update macro. This will insert the person's name from column "C" into the message body.

Sub SendEmailNotices()

  Dim Cell As Range
  Dim DateRng As Range
  Dim Msg As String
  Dim olApp As Object
  Dim olEmail As Object
  Dim Person As String
  Dim RngEnd As Range
  Dim Wks As Worksheet
  
    Set Wks = Worksheets("Sheet2")
    
    Set DateRng = Wks.Range("A11").Resize(ColumnSize:=10)
    Set RngEnd = Wks.Cells(Rows.Count, DateRng.Column).End(xlUp)
    Set DateRng = IIf(RngEnd.Row < DateRng.Row, DateRng, Wks.Range(DateRng, RngEnd))
    
   'Change this to what you want.
    Msg = "The repair for " & Person & " is due please check spreadsheet"
    
      For Each Cell In DateRng.Columns(6).Cells
        If Cell >= Int(Now() + 7) And Cell.Offset(0, 8) = "" Then
           Person = Cell.Offset(0, -3)
           If olApp Is Nothing Then Set olApp = CreateObject("Outlook.Application")
           Set olEmail = olApp.CreateItem(0)
             With olEmail
               .To = "reception@borgdental.com.au"
               .Subject = "Expiration notice"
               .Body = Msg
               .Send
             End With
           Cell.Offset(0, 8) = Now()
        End If
      Next Cell
      
    Set olApp = Nothing
    
End Sub

Hello Kid_K,

Glad to know everything is working well for you. Can this post be marked solved?

Hello Kid_K,

If there is a date in column "N" then the email will not be sent. After the email is sent, the current date and time is recorded in column "N" for that person. Tot test the emails you will need to clear the cells in column "N".