Email with rows included in VBA with additional criteria

[peapop]

Hi all,

I previously had sought help in this forum on how to create a macro that generate email(s) that add rows when specific text ("Critical") is found on column AF. Here are a few screenshots on how it looks like;

I would like to indicate a "Yes" in Column "AG" for those rows that are already processed by the macro, so when the macro is run the second time, it will prevent those rows of data which contain "Yes" in column AG to be added in the email.

This is the excellent code that was originally posted in the prev post

Option Explicit

Sub OrderCritical()     'Give your macro a meaningful name

' Macro to request quotes for all critical stock
 
    Dim vInput As Variant
    Dim lNmeRow As Long, lR As Long, UB1 As Long, UB2 As Long, lName As Long, _
        lEmailAdr As Long, lCatNr As Long, lAlert As Long, lQR As Long, lHeadrRow As Long, lC As Long
    Dim MailTo As String, MailSubject As String, MailBody As String, sAddRow As String, sHead As String, _
        sTableHdr As String
    Dim OutApp As Object, OutMail As Object
   
   
    'Check if  Outlook already opened
    Set OutApp = GetObject(Class:="Outlook.Application")

    If OutApp Is Nothing Then
        'Outlook is not opened, so open
        Set OutApp = CreateObject("Outlook.Application")
    End If
   
    'find header row
    lHeadrRow = Range("C:C").Find("Name").Row
    'Put database into array
    vInput = Range("C" & lHeadrRow).CurrentRegion.Value
   
    'number of rows in database:
    UB1 = UBound(vInput, 1)
    'number of columns in database:
    UB2 = UBound(vInput, 2)
   
    'Find columns to be used
    For lC = 1 To UB2
        sHead = vInput(1, lC)
        Select Case True
            Case sHead Like "Name*"
                lName = lC
            Case sHead Like "*Vendor*"
                lEmailAdr = lC
            Case sHead Like "Catalo*"
                lCatNr = lC
            Case sHead Like "Alert*"
                lAlert = lC
            Case sHead Like "Quotat*"
                lQR = lC
               
        End Select
    Next lC

    ' >>>> MailSubject does not change, so only needs to be created once, outside loop
    MailSubject = "Quotation Request"
         
 
    'Create the html table and header from the first row
    sTableHdr = "<table border=1><tr><th>" & vInput(1, lName) & "</th>" _
            & "<th>" & vInput(1, lCatNr) & "</th>" _
            & "<th>" & "Quantity" & "</th>" _

    'Check to see if column lAlert (AF) = 'SAFE' and skip mail if it does
    For lR = 2 To UB1
       
        If vInput(lR, lAlert) Like "CRITICAL" And Not vInput(lR, lQR) = True Then    'True is flag to indicate item already processed
           
            MailTo = vInput(lR, lEmailAdr)
           
            'Create MailBody table row for first row
            MailBody = "<tr>" _
                    & "<td>" & vInput(lR, lName) & "</td>" _
                    & "<td>" & vInput(lR, lCatNr) & "</td>" _
                    & "</tr>"
            'set flag that line is processed
            vInput(lR, lQR) = True
       
            'Second loop checks all critical items from the same vendor.
            For lC = lR + 1 To UB1
               
                If MailTo Like vInput(lC, lEmailAdr) And vInput(lC, lAlert) Like "CRITICAL" Then
                       
                    'Create additional table row for each extra row found"
                    sAddRow = "<tr>" _
                            & "<td>" & vInput(lC, lName) & "</td>" _
                            & "<td>" & vInput(lC, lCatNr) & "</td>" _
                            & "</tr>"
                   
                    MailBody = MailBody & sAddRow  '
                       
                    vInput(lC, lQR) = True
                       
                End If
            Next lC
           
            ' Now create email
            Set OutMail = OutApp.createitem(0)
            With OutMail
                 .To = MailTo
                 .Subject = MailSubject
                 .HTMLBody = sTableHdr & MailBody & "</table>"
                 .Display
             'send
            End With
                       
        End If
    Next lR
   
End Sub