Send different emails via Excel VBA based on cell value

I run a train-the-trainer training. I have a spreadsheet to create a PDF attendance certificate and an email to confirm they have passed the course to take on the trainer role.

This is all done via Excel VBA which I cannibalised from various sources.

I want to send different email contents depending on whether or not they passed.

In the worksheet labelled "Attendance" I have the following table/headers:

CourseID	Outcome	Title	First Name	Last Name	Subject	Area	UserID	Email	Filename
N100P	Not Ready	Mrs	Alice	One	English	England	1236547	alice@one.comm	N100P_AliceOne_1236547.pdf
N100P	Recommend	Mr	Bob	Two	Maths	Scotland	6548789	bob@two.ukk	N100P_BobTwo_6548789.pdf

CourseID = cell A1 Filename = cell J1

I have the below code:

Sub DraftEmailWithCerts()
Dim EApp As Object
Set EApp = CreateObject("Outlook.Application")
Dim EItem As Object
Dim path As String
path = Worksheets("PDF").Range("J2").Value 'path to folder of PDFs to be saved
Dim RList As Range
Set RList = Worksheets("Attendance").Range("A2", Worksheets("Attendance").Range("a2").End(xlDown))
Dim R As Range

For Each R In RList
    
    Set EItem = EApp.CreateItem(0)
    With EItem
        .To = R.Offset(0, 8)
        .Subject = Worksheets("Attendance").Range("A2").Value & " " & Worksheets("PDF").Range("J3").Value & ": Outcome" 'Attendance!A2 is training course ID and PDF!J3 is name of the training
        .Attachments.Add (path & R.Offset(0, 9))
        .SentOnBehalfOfName = "train@the.trainer.com"

        If Worksheets("Attendance").Range("B2").Value = "Not Ready" Then

            .HTMLBody = "<p>Thank you for your hard work and participation at the recent training.  Unfortunately the panel has concluded that you are not ready to take up the trainer role.</p>"
        
        Else
        
            .HTMLBody = "<p>Thank you for your hard work and participation at the recent training.  The panel has recommended you to take up the trainer role, congratulations.</p>"
    
        End If

        .Display
    End With

Next R
Set EApp = Nothing
Set EItem = Nothing
End Sub

I have a separate macro to create the necessary PDF and it works.

I am looking for the macro to send a "Not ready" email for Alice (because in the Outcome column B it says "Not ready") and a "Ready" email for Bob (his Outcome was "Recommend").

At the moment it sends everyone a "Not ready" email.

Solution

There are two issues with your code:

You are iterating the Rlist per each cell (!) of RList.
You always check Worksheets("Attendance").Range("B2").Value = "Not Ready" Then - the result will obviously always be true as the value in B2 does not change while code execution.

Therefore you have to iterate over each row of the list (For Each R In RList.Rows) and read the values from that row (If R.Cells(1, 2).Value = "Not Ready" Then). R returns a range e.g. A2:J2 for the first row of your list.

Sub DraftEmailWithCerts()
Dim EApp As Object
Set EApp = CreateObject("Outlook.Application")
Dim EItem As Object
Dim path As String
path = Worksheets("PDF").Range("J2").Value 'path to folder of PDFs to be saved


Dim RList As Range
Set RList = Worksheets("Attendance").Range("A2", Worksheets("Attendance").Range("a2").End(xlDown))
Dim R As Range

For Each R In RList.Rows
    
    Set EItem = EApp.CreateItem(0)
    With EItem
        .To = R.Cells(1, 9)
        .Subject = R.Cells(1, 1) & " " & Worksheets("PDF").Range("J3").Value & ": Outcome" 'Attendance!A2 is training course ID and PDF!J3 is name of the training
        .Attachments.Add (path & R.Cells(1, 10))
        .SentOnBehalfOfName = "train@the.trainer.com"

        If R.Cells(1, 2).Value = "Not Ready" Then
            .HTMLBody = "<p>Thank you for your hard work and participation at the recent training.  Unfortunately the panel has concluded that you are not ready to take up the trainer role.</p>"
        Else
            .HTMLBody = "<p>Thank you for your hard work and participation at the recent training.  The panel has recommended you to take up the trainer role, congratulations.</p>"
        End If

        .Display
    End With

Next R
Set EApp = Nothing
Set EItem = Nothing
End Sub