Welcome to the forum!
In a Module:
Code:
Sub Main()
Dim c As Range, f As Range, source As Worksheet, master As Worksheet, s As String
'Add reference: Microsoft Outlook xx.x Library, where xx.x is 14.0, 15.0, 16.0, etc.
Dim olApp As Outlook.Application, olMail As Outlook.MailItem
Set source = Worksheets("Request List")
Set master = Worksheets("Master List")
Set olApp = New Outlook.Application
For Each c In source.Range("A2", source.Cells(source.Rows.Count, "A").End(xlUp))
With c
If .Offset(, 2).Value <> "NO" Then GoTo NextC
If .Offset(, 4).Value <> True Then GoTo NextC
Set f = master.Range("A:A").Find(c.Value)
Set olMail = olApp.CreateItem(olMailItem)
With olMail
.To = f.Offset(, 3).Value 'Master Column D
.CC = f.Offset(, 5).Value 'Master Column E
.Subject = "Catalog Request: " & c.Offset(, 1).Value 'Source Column B
'Build body string:
s = "Hello " & f.Offset(, 1).Value & "," & vbCrLf & vbCrLf
s = s & "May you please send the Subsidiary Catalog List for " & _
c.Offset(, 1).Value & "?" & vbCrLf & vbCrLf
s = s & "Thanks you," & vbCrLf & vbCrLf
s = s & "sig data..."
.Body = s
.Display
'.Send
End With
.Offset(, 2).Value = "YES" 'Source sheet sent, YES.
.Offset(, 3).Value = Date 'Source sheet, Date sent.
End With
NextC:
Next c
On Error Resume Next
Set olMail = Nothing
Set olApp = Nothing
End Sub
Bookmarks