Excel - Email Notifications Reminders

Can you try this update to your macro:

Sub sendreminders()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    
    Set OutApp = CreateObject("outlook.application")
    OutApp.session.logon
    
    On Error GoTo cleanup
    Dim row As Integer
    Dim ws As Worksheet
    Set ws = Worksheets("sheet1")
    row = 2
    Do
        Dim col As Variant
        
If IsDate(ws.Cells(row, 11).Value) Then
 
    If DateDiff("d", Date, CDate(ws.Cells(row, 11).Value)) >= 7 Then
        If IsDate(ws.Cells(row, 13)) Then GoTo nxtRow
        If IsDate(ws.Cells(row, 12)) Then
            If DateDiff("d", Date, CDate(ws.Cells(row, 12).Value)) < 7 Then GoTo nxtRow
        End If
        
        Set OutMail = OutApp.createitem(0)
                
        On Error Resume Next
        With OutMail
            .To = "c.lewis@caswell-group.co.uk"
            .Subject = " Reminder for " & ws.Cells(row, 1) & " " & ws.Cells(row, 2) & " Has not been priced and was recieved on " & ws.Cells(row, 11)
            .Body = "Dear Carl" & vbNewLine & vbNewLine & _
                " Please note that " & ws.Cells(row, 1) & " " & ws.Cells(row, 2) & " Has not been priced and was recieved on " & ws.Cells(row, 11)
            .Send
        End With
        
        If IsDate(ws.Cells(row, 12)) Then ws.Cells(row, 13) = Date Else ws.Cells(row, 12) = Date
    
    On Error GoTo 0
                  
    Set OutMail = Nothing
 
    End If
End If
    
nxtRow:
 
    row = row + 1
    Loop Until ws.Cells(row, 1) = ""
    
cleanup: Set OutMail = Nothing
        
End Sub

Select allOpen in new window

I have tried and it doesn't seem to do anything??  Here is code for one that i already use but i don't know how to copy it across so it applies...

Sub sendRemindersForWorksheet(ByRef ws As Worksheet)
    Dim row As Long, i As Long, n As Long
    Dim sReminder As String, sMessage As String
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim datLast As Date, datNext As Date
   
    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon
 
    On Error GoTo cleanup
   
    n = ws.Cells(Rows.Count, 1).End(xlUp).row
    For row = 2 To n
        sReminder = ""
        datLast = Application.Max(ws.Rows(row))
        datNext = datLast + 30
        If datLast > 0 Then
            i = ws.Rows(row).Find(datLast).Column
            Select Case Date - datLast
            Case Is >= 30
                If ws.Cells(row, i + 2) = "" Then
                    sReminder = "Last" 'Needs the Last reminder
                    ws.Cells(row, i + 2).Value = sReminder & Format(Date, " d/m") ' mark as sent
                End If
            Case Is >= 15
                If ws.Cells(row, i + 1) = "" Then
                    sReminder = "1st" 'Needs the 1st reminder
                    ws.Cells(row, i + 1).Value = sReminder & Format(Date, " d/m") ' mark as sent
                End If
            End Select
            If sReminder <> "" Then
                sMessage = ws.Cells(row, 1) & " " & ws.Cells(row, 2) & " in van " & ws.Cells(row, 3) & _
                    " needs a new van air test by " & Format(datNext, "d mmmm")
                Set OutMail = OutApp.CreateItem(0)
                With OutMail
                    .To = "test@test.co.uk"          'Please put in the correct e-mail address
                    .Subject = sReminder & " Reminder for " & sMessage
                    .Body = "Dear Carl" & vbNewLine & vbNewLine & "Please note that " & sMessage
                    .Send
                End With
            End If
        End If
    Next
       
    Set OutMail = Nothing
   
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True
End Sub

Carlandrewlewis

Any Update?

Chris

Chris, sorry for the major delay, i have been working away therefore not been able to confirm this. Anyway thanks for your help!!!