Macro to send emails from excel using filters

[Kiran Kurapati]

Hi All

I am looking for a macro where it send emails automatically from my excel using the following filters

 Send emails to the Contact name wherever

- Completion DT is blank ,
- Vendor tier Risk level is not Low
- Submit date is not Blank,
- Comments are blank
- Duplicate is blank

sample test - macro to send emails with multiple filters.xlsx

I have highlight the columns (blue color) where email needs to be sent from excel basing on the above filters

 Should send mails from kiran_kurapati777@yahoo.com
 update with the Date in th the mail Sent Date column as soon as mail is sent.
 Post which automatically Save the file “Training_Followup_Done_Date” on desktop
 Once the file is save…. A Message box should pop up saying “Task Completed”
 After the 7 days of running a macro a reminder mail should be sent to kiran_kurapati777@yahoo.com Saying “Kindly check for updates in the Training follow up project”
Thank you for all your support

Regards
Kiran Kumar

[Kiran Kurapati]

Here we go.... got a solution

Sub Mail()
'
' Macro1 Macro
'

'
    Range("D5").Select
  Do Until Selection.Offset.Value = ""
      If Selection.Offset.Value <> "Low" Then
     ActiveCell.Offset(0, 1).Select
    If Selection.Offset.Value <> "" Then
      Selection.Offset(0, 7).Select
      If Selection.Offset.Value = "" Then
      Selection.Offset(0, 1).Select
      If Selection.Offset.Value = "" Then
      Selection.Offset(0, 1).Select
       If Selection.Offset.Value = "" Then
      Selection.Offset(0, 1).Select
      A = ActiveCell.Value
         Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
   ' Change the mail address and subject in the macro before you run it.
    With OutMail
    .sentonbehalfofname = A
    ActiveCell.Offset(0, -4).Select
        .To = ActiveCell.Value
        .CC = ""
        .BCC = ""
         .Subject = "Training file"
        .Close olSave
      ActiveCell.Offset(0, 11).Select
      strbdy = "Dear " & vbCrLf & "<br><br>As per our records, write your body here <br>" & vbCrLf & "<br>"
      strbdy1 = "change of paragraph <br>" & vbCrLf & "<br>"
      strbdy2 = "Do write to us with your questions and Queries at xyz@abc.com. Thanks!!" & "<br><br>Regards<br>XYZ Team <br>" & vbCrLf & "<br>"
        .htmlBody = strbdy & strbdy1 & strbdy2
        .Save
        .Send
         End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
    
    ActiveCell.Offset(0, 5).Select
    ActiveCell.FormulaR1C1 = Now
    ActiveCell.Offset(0, -2).Select
      End If
      Selection.Offset(0, -1).Select
      End If
      Selection.Offset(0, -1).Select
      End If
      Selection.Offset(0, -7).Select
      End If
       Selection.Offset(0, -1).Select
      End If
    Selection.Offset(1, 0).Select
    Loop
     ActiveWorkbook.SaveAs Filename:= _
        "C:\Users\xyz\Desktop\xlm.xlsm", FileFormat:= _
        xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
    End Sub