Email Selected range in a table based on the vendor or email address as a table in the email body

[SteynBS]

I have multiple products from different suppliers. I need to email each supplier a table with only their products. I have more than 2000 suppliers with each about 10 to 100 products. I need the supplier to complete the data required for each product.

a code from @DanteAmor works to filter and place the email address into the "to" section, but I don't know how to get the table either attached or part as the body in the email

Vendor Name is in E, email address is in F, A:H is the whole table or Table8.

Sub create_multiple_emails()
Dim c As Range, sh As Worksheet, ky As Variant, m As Range, sBody As String
Dim dam As Object, dict As Object

Set sh = Sheets("MASTER")
Set dict = CreateObject("scripting.dictionary")
For Each c In sh.Range("F2", sh.Range("F" & Rows.Count).End(xlUp))
If Not dict.exists(c.Value) Then
dict(c.Value) = dict(c.Value)
sh.Range("A1").AutoFilter 1, C

Set dam = CreateObject("Outlook.Application").CreateItem(0)
dam.To = c
dam.Subject = "Subject"
dam.body = sBody
'dam.Send 'to send
dam.display 'to show
End If
Next
sh.ShowAllData
End Sub

 

[DanteAmor]

Try this:

Sub create_multiple_emails()
  Dim sh As Worksheet
  Dim c As Range, rng As Range
  Dim dic As Object
  Dim lr As Long
  
  Set sh = Sheets("MASTER")
  Set dic = CreateObject("scripting.dictionary")
  If sh.AutoFilterMode Then sh.AutoFilterMode = False
  lr = sh.Range("F" & Rows.Count).End(xlUp).Row
  
  For Each c In sh.Range("F2:F" & lr)
    If Not dic.exists(c.Value) Then
      dic(c.Value) = dic(c.Value)
      sh.Range("A1:H" & lr).AutoFilter 6, c.Value
      Set rng = sh.Range("A1:H" & lr)
      With CreateObject("Outlook.Application").CreateItem(0)
        .To = c.Value
        .Subject = "Subject"
        .HTMLBody = RangetoHTML(rng)
        '.Send 'to send
        .display 'to show
      End With
    End If
  Next
  sh.ShowAllData
End Sub

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006. Working in Office 2000-2016
  Dim fso As Object, ts As Object
  Dim TempFile As String, TempWB As Workbook
  
  TempFile = Environ$("temp") & "\temp.htm"
  'Copy the range and create a new workbook to past the data in
  rng.Copy
  Set TempWB = Workbooks.Add(1)
  With TempWB.Sheets(1)
    .Cells(1).PasteSpecial Paste:=8
    .Cells(1).PasteSpecial xlPasteValues, , False, False
    .Cells(1).PasteSpecial xlPasteFormats, , False, False
    .Cells(1).Select
    Application.CutCopyMode = False
    On Error Resume Next
    .DrawingObjects.Visible = True
    .DrawingObjects.Delete
    On Error GoTo 0
  End With
  
  'Publish the sheet to a htm file
  With TempWB.PublishObjects.Add(xlSourceRange, TempFile, TempWB.Sheets(1).Name, TempWB.Sheets(1).UsedRange.Address, xlHtmlStatic)
    .Publish (True)
  End With
  
  'Read all data from the htm file into RangetoHTML
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
  RangetoHTML = ts.readall
  ts.Close
  RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", "align=left x:publishsource=")
  
  'Close TempWB
  TempWB.Close savechanges:=False
  'Delete the htm file we used in this function
  Kill TempFile
  Set ts = Nothing
  Set fso = Nothing
  Set TempWB = Nothing
End Function

-------------------------------------
Note Code Tag:
In future please use code tags when posting code.
How to Post Your VBA Code it makes your code easier to read and copy and it also maintains VBA formatting.