Filter cells and emial filter result

[5h1v]

Hey,

I am hoping you could help me, I want to filter a worksheet on the name of a supplier(column C) and on todays date (Column T) and then email them columns C:T from that filtered information could anyone help?

Thanks

 

[5h1v]

That works, but how does it send an email to each supplier who will have a different email address?

 

[DanteAmor]

That works, but how does it send an email to each supplier who will have a different email address?

you must answer the questions I asked in posts #2 , #4 #8

 

[5h1v]

Sure I will try;

Do you want to send mail by outlook? - Yes
Do you want to generate a file with the filtered information and send the file? - Yes
What name will the file have? - "DD/MM/YY Supplier Name" From the supplier column
What mail? Outlook
What is the subject? "DD/MM/YY Supplier Name" From the supplier column
What is the body of the mail? "Hi XXX, Please see attached. Regards XXX"

To which email? supplier1@supplier1.com supplier2@supplier2.com etc etc

In which row are your headings? 1
In which row do your data start? 2
Do you want the headings in the file? yes please

Do you have data with today's date? Yes
Can you put a sample of your data? have done

I hope that covers it all

Sorry I dont seem to be very helpful

 

[5h1v]

Anymore help would be greatly appreciated.

 

[DanteAmor]

Try

Sub create_multiple_emails()
  Dim wb As Workbook, sh As Worksheet, c As Range, m As Range
  Dim sBody As String, wFile As String
  Dim dam As Object, dict As Object
  '
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  '
  Set sh = ActiveSheet
  Set dict = CreateObject("scripting.dictionary")
  If sh.AutoFilterMode Then sh.AutoFilterMode = False
  sh.Range("A1").AutoFilter Field:=20, Criteria1:=xlFilterToday, Operator:=xlFilterDynamic
  For Each c In sh.Range("C2", sh.Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
    If Not dict.exists(c.Value) Then
      dict(c.Value) = dict(c.Value)
      sh.Range("A1").AutoFilter 3, c
      Set wb = Workbooks.Add
      sh.AutoFilter.Range.EntireRow.Copy Range("A1")
      wFile = ThisWorkbook.Path & "\" & Format(Date, "dd-mm-yyyy") & " " & c.Value & ".xlsx"
      wb.SaveAs wFile
      wb.Close False
      Set dam = CreateObject("Outlook.Application").CreateItem(0)
      '
      'Mail Information
      dam.To = "[COLOR=#0000ff]supplier1@supplier1.com; supplier2@supplier2.com; etc; etc[/COLOR]"
      dam.Subject = "Subject ?????"
      dam.Body = "Hi XXX, Please see attached. Regards XXX"
      dam.Attachments.Add wFile
      dam.Display 'use .Send to send
    End If
  Next
  sh.ShowAllData
  MsgBox "Emails sent"
End Sub

 

[5h1v]

That works but I need the name in the supplier column to relate to the suppliers email address, I don't want every supplier to receive every email

 

[DanteAmor]

That works but I need the name in the supplier column to relate to the suppliers email address, I don't want every supplier to receive every email

But you haven't explained how to get the email address.

You must put other examples here to see how your data is and where to pull the email address.

 

[5h1v]

Sure I can do that I was just going from a listing from my head but I will enter a reference on a separate sheet apologises.

 

[5h1v]

http://s000.tinyupload.com/index.php?file_id=69455162262787379040

added a sheet to see the contact details. would also like it if the emails would hide columns A,B and U-BH if possible.

Thanks again

 

[DanteAmor]

Structure of the email sheet:

Supplier Contact Details
<table border="1" cellspacing="0" style="font-family:Calibri,Arial; font-size:11pt; background-color:#ffffff; "> <colgroup><col style="font-weight:bold; width:30px; " /><col style="width:60.83px;" /><col style="width:93.15px;" /><col style="width:185.35px;" /><col style="width:192.95px;" /><col style="width:167.29px;" /><col style="width:60.83px;" /></colgroup><tr style="background-color:#cacaca; text-align:center; font-weight:bold; font-size:8pt; "><td > </td><td >A</td><td >B</td><td >C</td><td >D</td><td >E</td><td >F</td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >1</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >2</td><td > </td><td > </td><td >Contact 1</td><td >Contact 2</td><td >Contact 3</td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >3</td><td > </td><td >Supplier 1</td><td style="color:#0563c1; text-decoration:underline; ">Supplier1v1@supplier.com</td><td style="color:#0563c1; text-decoration:underline; ">Supplier1v2@supplier.com</td><td style="color:#0563c1; text-decoration:underline; ">Supplier1v2@supplier.com</td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >4</td><td > </td><td >Supplier 2</td><td style="color:#0563c1; text-decoration:underline; ">Supplier2v1@supplier.com</td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >5</td><td > </td><td >Supplier 3</td><td style="color:#0563c1; text-decoration:underline; ">Supplier3v1@supplier.com</td><td style="color:#0563c1; text-decoration:underline; ">Supplier3v2@supplier.com</td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >6</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr><tr style="height:19px ;" ><td style="font-size:8pt; background-color:#cacaca; text-align:center; " >7</td><td > </td><td > </td><td > </td><td > </td><td > </td><td > </td></tr></table>

Note: Do not change the structure of the sheet.

Try this

Sub create_multiple_emails()
  Dim wb As Workbook, sh As Worksheet, c As Range, m As Range
  Dim sBody As String, wFile As String
  Dim dam As Object, dict As Object
  Dim sh2 As Worksheet, f As Range, EmailAddress As String, j As Long
  '
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  '
  Set sh = ActiveSheet
  Set sh2 = Sheets("Supplier Contact Details")
  Set dict = CreateObject("scripting.dictionary")
  If sh.AutoFilterMode Then sh.AutoFilterMode = False
  sh.Range("A1").AutoFilter Field:=20, Criteria1:=xlFilterToday, Operator:=xlFilterDynamic
  For Each c In sh.Range("C2", sh.Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible)
    If Not dict.exists(c.Value) Then
      dict(c.Value) = dict(c.Value)
      sh.Range("A1").AutoFilter 3, c
      Set f = sh2.Range("B:B").Find(c, , xlValues, xlWhole)
      If Not f Is Nothing Then
        For j = 3 To sh2.Cells(f.Row, Columns.Count).End(xlToLeft).Column
          EmailAddress = EmailAddress & ";" & sh2.Cells(f.Row, j)
        Next
      Else
        EmailAddress = [COLOR=#ff0000]"email@yahoo.com"[/COLOR]   'Mail in case there is no mail on sheet2
      End If
      Set wb = Workbooks.Add
      sh.AutoFilter.Range.EntireRow.Copy Range("A1")
      wFile = ThisWorkbook.Path & "\" & Format(Date, "dd-mm-yyyy") & " " & c.Value & ".xlsx"
      wb.SaveAs wFile
      wb.Close False
      Set dam = CreateObject("Outlook.Application").CreateItem(0)
      '
      'Mail Information
      dam.To = EmailAddress
      dam.Subject = "Subject ?????"
      dam.Body = "Hi XXX, Please see attached. Regards XXX"
      dam.Attachments.Add wFile
      dam.Display 'use .Send to send
    End If
  Next
  sh.ShowAllData
  MsgBox "Emails sent"
End Sub