Sending emails from excel based on row - Urgent

E

exceluser9

Active Member
Joined
Jun 27, 2015
Messages
388
Hi Team,

I have a data as below and the data starts from row 3. Row 1 and 2 are headers.

What i want macro to do is to create a new workbook for respective user and draft an email with standard text from outlook. In below example for James there should be 2 emails generated because the name is same and the email address is different.

Also if the generic mail id is different then it has to create a new workbook for this generic id.

So the logic will be based on Generic mailid, User and User email and these headers are in row 2

Generic mailid - column E
User - column - H
User email address column P

Data will be until row AZ


Text is - Please go through attached file.


Workbook should be created from row 1 till the end of the data.

IDFromDateCountryGeneric mailidContracter nameActivityUserReporterFormTATDaysFormTATDaysUser email
8675John05/03/2019ENGRoy@gmail.comMullerSetupWrightRonak Wight@gmail.com
78678Kevin13/03/2019ASTRoy@gmail.comDanoneSetupJamesRonak James@gmail.com
8679Johny05/04/2019RSRoy@gmail.comNestleSetupVinceRoy Vince@gmail.com
78673Kevin Peter13/02/2019ITRoy@gmail.comChocoSetupJamesRonak James@gmail.com
8787Paul13/03/2019ITRoy@gmail.comDominosSetupJamesJaison Jamesorg@gmail.com
86752John05/03/2019ENGRoy@ymail.comMullerSetupWrightRonak Wight@gmail.com
786784Kevin13/03/2019ASTRoy@ymail.comDanoneSetupJamesRonak James@gmail.com
86796Johny05/04/2019RSRoy@ymail.comNestleSetupVinceRoy Vince@gmail.com
786739Kevin Peter13/02/2019ITRoy@ymail.comChocoSetupJamesRonak James@gmail.com
87875Paul13/03/2019ITRoy@ymail.comDominosSetupJamesJaison Jamesorg@gmail.com

<colgroup><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><tbody>
</tbody>

Thanks
 
Sort by date Sort by votes
but you said:

"Data will bee until row AZ"

Then, for the test. Remove the meged cells from column AA and try again.
 
Upvote 0

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Ok I will try

Also i want to enter CC email address as well and in column "E" will have different generic email address can outlook use that as from email address?

Can outlook also pick signature?
 
Upvote 0
Try

Code: 
Code:
Sub Sending_emails()
  Dim c As Range, sh As Worksheet, Ky As Variant, dam As Variant, dict As Object
  Dim correo As String, lr As Long, wFile As String
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  Set sh = Sheets("Sheet1")
  If sh.AutoFilterMode Then sh.AutoFilterMode = False
  lr = sh.Range("E" & Rows.Count).End(xlUp).Row
  sh.Range("BA:BA").ClearContents
  For Each c In sh.Range("E3", sh.Range("E" & Rows.Count).End(xlUp))
    sh.Range("BA" & c.Row) = c & sh.Range("H" & c.Row) & sh.Range("P" & c.Row)
  Next
  
  Set dict = CreateObject("scripting.dictionary")
  For Each c In sh.Range("BA3", sh.Range("BA" & Rows.Count).End(xlUp))
    dict.Item(c.Value) = sh.Range("P" & c.Row)
  Next
  For Each Ky In dict.Keys
    correo = dict(Ky)
    sh.Range("A1:BA" & lr).AutoFilter Columns("BA").Column, Ky
    Workbooks.Add
    sh.AutoFilter.Range.EntireRow.Copy Range("A1")
    Range("BA:BA").ClearContents
    wFile = ThisWorkbook.Path & "\book.xlsx"
    ActiveWorkbook.SaveAs wFile
    ActiveWorkbook.Close False
    Set dam = CreateObject("Outlook.Application").CreateItem(0)
    dam.To = correo
    dam.Subject = "Please go through attached file."
    dam.Body = "body"
    dam.Attachments.Add wFile
    dam.Display   'use .Send to send
  Next Ky
  sh.ShowAllData
  MsgBox "Done"
End Sub
 
Upvote 0
Thanks Dante

Where do I enter CC email address as well and in column "E" will have different generic email address can outlook use that as from email address?

Can outlook also pick signature?
 
Upvote 0
exceluser9 said:
Thanks Dante

Where do I enter CC email address as well and in column "E" will have different generic email address can outlook use that as from email address?

Can outlook also pick signature?
Click to expand...

Try:

Code: 
Sub Sending_emails()
  Dim c As Range, sh As Worksheet, Ky As Variant, dam As Variant, dict As Object
  Dim correo As String, lr As Long, wFile As String
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
  
  Set sh = Sheets("Sheet1")
  If sh.AutoFilterMode Then sh.AutoFilterMode = False
  lr = sh.Range("E" & Rows.Count).End(xlUp).Row
  sh.Range("BA:BA").ClearContents
  For Each c In sh.Range("E3", sh.Range("E" & Rows.Count).End(xlUp))
    sh.Range("BA" & c.Row) = c & sh.Range("H" & c.Row) & sh.Range("P" & c.Row)
  Next
  
  Set dict = CreateObject("scripting.dictionary")
  For Each c In sh.Range("BA3", sh.Range("BA" & Rows.Count).End(xlUp))
    dict.Item(c.Value) = sh.Range("P" & c.Row)
  Next
  For Each Ky In dict.Keys
    correo = dict(Ky)
    sh.Range("A1:BA" & lr).AutoFilter Columns("BA").Column, Ky
    Workbooks.Add
    sh.AutoFilter.Range.EntireRow.Copy Range("A1")
Dim wcc
Wcc = range("E3")
    Range("BA:BA").ClearContents
    wFile = ThisWorkbook.Path & "\book.xlsx"
    ActiveWorkbook.SaveAs wFile
    ActiveWorkbook.Close False
    Set dam = CreateObject("Outlook.Application").CreateItem(0)
    dam.To = correo
dam.cc = wcc
    dam.Subject = "Please go through attached file."
    dam.Body = "body"
    dam.Attachments.Add wFile
    dam.Display   'use .Send to send
  Next Ky
  sh.ShowAllData
  MsgBox "Done"
End Sub


if the signature is a text you can write it where it says "body"
 
Upvote 0
Do I have to enter cc email address in place of wcc? And where do I enter from email address will it be picked from column E?

dam.cc = wcc
 
Upvote 0
Does the macro work for your original requirement?
 
Upvote 0
Hi Dante,

Yes it works,

But I have headers in row 1 and 2.

Please could you amend code at below line to tick the blank as well so it picks header.

sh.Range("A1:BA" & lr).AutoFilter Columns("BA").Column, Ky
 
Upvote 0
Try this


Code: 
[COLOR=#333333]sh.Range("A[/COLOR][COLOR=#ff0000][B]2[/B][/COLOR][COLOR=#333333]:BA" & lr).AutoFilter Columns("BA").Column, Ky[/COLOR]
 
Upvote 0
Hi Dante,

I tried the code which you gave but row 1 it wasnt copying. Hence, i have changed to below and it works fine now

sh.Range("A1:BA" & lr).AutoFilter Columns("BA").Column, Ky
sh.Range("A1:BA" & lr).AutoFilter Columns("BA").Column, Ky, xlOr, " ", True
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,221,526
Messages
6,160,340
Members
451,637
Latest member
hvp2262

Share this page

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