Reminder emails after 30 and 60 days.

Hello meatcat,

Welcome to the Forum!

The macro below will check the worksheet hire dates. If today's date is either 30 or 60 days past the hire date and there is no email date for the 30 or 60 day mark, a email will be sent using Outlook. The attached workbook contains the macro shown and a button on the worksheet has been added to run the macro.

Macro Code

Sub SendEmails()

    Dim Cell As Range
    Dim Day30 As Variant
    Dim Day60 As Variant
    Dim Employee As String
    Dim HireDate As Range
    Dim Manager As String
    Dim ManagerEmail As String
    Dim Message As String
    Dim olApp As Object
    Dim Rng As Range
    Dim Wks As Worksheet
    
        Set Wks = ActiveSheet
        Set Rng = Wks.Range("A1").CurrentRegion
                
        Set olApp = CreateObject("Outlook.Application")
        
            Set Rng = Intersect(Rng.Offset(1, 0), Rng)
            
            For Each Cell In Rng.Columns(5).Cells
                Set HireDate = Cell.Offset(0, -3)
                If Now + 30 >= HireDate + 30 And Cell = "" Then
                    Cell = HireDate + 30
                    Manager = HireDate.Offset(0, 1)
                    ManagerEmail = HireDate.Offset(0, 2)
                    Message = "Please conduct your 30 day review for " & HireDate.Offset(0, -1) & "."
                        With olApp.CreateItem(0)
                            .To = ManagerEmail
                            .Subject = "30 Day Review"
                            .Body = "Dear " & Manager & "," & vbCrLf & vbCrLf & Message
                            .Send
                        End With
                End If
            Next Cell
                
            For Each Cell In Rng.Columns(6).Cells
                Set HireDate = Cell.Offset(0, -4)
                If Now + 60 >= HireDate + 60 And Cell = "" Then
                    Cell = HireDate + 60
                    Manager = HireDate.Offset(0, 1)
                    ManagerEmail = HireDate.Offset(0, 2)
                    Message = "Please conduct your 60 day review for " & HireDate.Offset(0, -1) & "."
                        With olApp.CreateItem(0)
                            .To = ManagerEmail
                            .Subject = "60 Day Review"
                            .Body = "Dear " & Manager & "," & vbCrLf & vbCrLf & Message
                            .Send
                        End With
                End If
            Next Cell
        
End Sub