Home |
Search |
Today's Posts |
#1
|
|||
|
|||
Loop through email address list to send e-mails
Hi Every one,
Following is a code that prints out weekly individual task lists from a master Critical Path. The code first creates a list of unique individuals on a temporary page, -then filter my critical path in a Column called "Next week" to only show action requiring follow-up on following week. -then prints-out a list of individuals who will receive task lists, -and finaly loops through alll values in "MyUniqueRng" to filter and print out the list name by name. What I would like to do, is instead of Printing-out these individuals task lists, sending them by e-mail whith outlook Provided that all names are listed on another separate sheet (Whole list of employees) and that I would write their e-mail addresses on a column at the right of the "Name" column, I assume that by a loop through the range "MyUniqueRng" combined to a V-Lookup these addresses could easily be pasted in outlook to send individual e-mails. It would be great If somebody could assist me in this matter. Thanks, Paul Sub Print_Next_Weeek_Task_Lists() Application.ScreenUpdating = False Dim newWks As Worksheet Dim curWks As Worksheet Dim myRng As Range Dim myRng2 As Range Dim myUniqueRng As Range Dim myCell As Range Set curWks = Sheets("Critical Path") Set newWks = Worksheets.Add With curWks .AutoFilterMode = False Set myRng = .Range("A6", .Cells.SpecialCells(xlCellTypeLastCell)) Set myRng2 = .Range("A5", .Cells.SpecialCells(xlCellTypeLastCell)) myRng2.AutoFilter Field:=16, Criteria1:="<" myRng.Columns(4).Copy _ Destination:=newWks.Range("a1") With newWks .Range("a1", .Cells(.Rows.Count, "a")).AdvancedFilter _ Action:=xlFilterCopy, CopyToRange:=.Range("b1"), Unique:=True .Range("b:b").Sort Key1:=Range("b1"), _ Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom Set myUniqueRng = .Range("b1", .Cells(.Rows.Count, "b").End(xlUp)) End With With Sheets("Task List Distribution NW") ' Prints Task List Distribution Record myUniqueRng.Copy Sheets("Task List Distribution NW").Select Range("A7").PasteSpecial (xlPasteValues) .PrintOut Copies:=1, preview:=False Range("A7:A60").ClearContents End With .Range("L4").Value = "Next Week" For Each myCell In myUniqueRng.Cells << L myRng2.AutoFilter Field:=4, Criteria1:=myCell.Value << O .Range("O3").Value = myCell.Value << O .PrintOut Copies:=1, preview:=False << P Next myCell .Range("O3:P3").ClearContents .Range("L4").ClearContents If .FilterMode Then .ShowAllData End If End With Application.DisplayAlerts = False newWks.Delete Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub |
#2
|
|||
|
|||
There are people here who are clever enough to help you handle this in Excel,
but I'll point out that Word XP (maybe earlier versions, too) have an option to mailmerge to Outlook emails. It sounds pretty easy, and may be easier than handling it all in Excel. "Paul." wrote: Hi Every one, Following is a code that prints out weekly individual task lists from a master Critical Path. The code first creates a list of unique individuals on a temporary page, -then filter my critical path in a Column called "Next week" to only show action requiring follow-up on following week. -then prints-out a list of individuals who will receive task lists, -and finaly loops through alll values in "MyUniqueRng" to filter and print out the list name by name. What I would like to do, is instead of Printing-out these individuals task lists, sending them by e-mail whith outlook Provided that all names are listed on another separate sheet (Whole list of employees) and that I would write their e-mail addresses on a column at the right of the "Name" column, I assume that by a loop through the range "MyUniqueRng" combined to a V-Lookup these addresses could easily be pasted in outlook to send individual e-mails. It would be great If somebody could assist me in this matter. Thanks, Paul Sub Print_Next_Weeek_Task_Lists() Application.ScreenUpdating = False Dim newWks As Worksheet Dim curWks As Worksheet Dim myRng As Range Dim myRng2 As Range Dim myUniqueRng As Range Dim myCell As Range Set curWks = Sheets("Critical Path") Set newWks = Worksheets.Add With curWks .AutoFilterMode = False Set myRng = .Range("A6", .Cells.SpecialCells(xlCellTypeLastCell)) Set myRng2 = .Range("A5", .Cells.SpecialCells(xlCellTypeLastCell)) myRng2.AutoFilter Field:=16, Criteria1:="<" myRng.Columns(4).Copy _ Destination:=newWks.Range("a1") With newWks .Range("a1", .Cells(.Rows.Count, "a")).AdvancedFilter _ Action:=xlFilterCopy, CopyToRange:=.Range("b1"), Unique:=True .Range("b:b").Sort Key1:=Range("b1"), _ Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, _ Orientation:=xlTopToBottom Set myUniqueRng = .Range("b1", .Cells(.Rows.Count, "b").End(xlUp)) End With With Sheets("Task List Distribution NW") ' Prints Task List Distribution Record myUniqueRng.Copy Sheets("Task List Distribution NW").Select Range("A7").PasteSpecial (xlPasteValues) .PrintOut Copies:=1, preview:=False Range("A7:A60").ClearContents End With .Range("L4").Value = "Next Week" For Each myCell In myUniqueRng.Cells << L myRng2.AutoFilter Field:=4, Criteria1:=myCell.Value << O .Range("O3").Value = myCell.Value << O .PrintOut Copies:=1, preview:=False << P Next myCell .Range("O3:P3").ClearContents .Range("L4").ClearContents If .FilterMode Then .ShowAllData End If End With Application.DisplayAlerts = False newWks.Delete Application.DisplayAlerts = True Application.ScreenUpdating = True End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
email address hyperlink | Excel Worksheet Functions | |||
Using CONCATENATE function to create email addresses from a list | Excel Worksheet Functions | |||
Help me Please!! Need hyperlinks to show actual email address! | New Users to Excel | |||
how do I make make my hyperlinks show the email address they are . | Excel Discussion (Misc queries) | |||
Shut off email address from linking to email program? | Excel Worksheet Functions |