Filter cells and emial filter result

5h1v

Board Regular
Joined
Oct 11, 2012
Messages
69
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
 
That works, but how does it send an email to each supplier who will have a different email address?
 
Upvote 0

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
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
 
Upvote 0
Try

Code:
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
 
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0
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.
 
Upvote 0
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

Code:
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
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top