Email To-Do list to Team members in One Click using Excel VBA

In this blog, we will discuss how to email To-Do list from your outlook mail to respective team members. You would have sent email from outlook but probably not using Excel VBA Code.

For example, you have a To-Do list in your excel file with tasks assigned to each team member and you need to send emails with the assigned task to all your team members. If you do it manually then you need to apply a filter and choose team member’s task one by one and then paste in another sheet and then change the format of the database you have copied and finally need to paste the date in your email.

Let’s look at the example. Assume you have the database like below:

Database Picture-1(Picture 1)

From the above picture, you can understand that there are some tasks are defined in a To-Do list. A task should be assigned to a person with a start date and due date.

Now if you do it manually you will apply a filter on your name column and then copy the data and paste it another sheet which should look like below:

Database Picture-2(Picture 2)

Then after manually doing this you can copy the same and paste it in your outlook mail and then you need to send the email.
Database Picture-3(Picture 3)

Now you have done for only 1 employee. You need to do the same for other employees also. Now think if you need to send the task to 50 team members then you will have to do the task for 50 times.

At the same time, a small piece of code will do the task for you. You don’t have to be a programmer to do the same. All you need to know is Where and How to paste the code to run that Excel VBA code.

Follow the below steps to do it automatically:

    1. Press Alt + F11 to go to VBA page
    2. Click on Insert and then Module
    3. Copy the below code and paste the Module
    4. Press F5 to run the code
Sub ExtractDataandsendemail()

Sheets("PullData").Visible = xlSheetVisible

Dim ws     As Worksheet

Dim wsNew  As Worksheet

Dim rData  As Range

Dim rfl    As Range

Dim prsn  As String

Set ws = ThisWorkbook.Sheets("data")

Application.DisplayAlerts = False

With ws

Set rData = .Range(.Cells(1, 1), .Cells(.Rows.Count, 9).End(xlUp))

.Columns(.Columns.Count).Clear

.Range(.Cells(2, 2), .Cells(.Rows.Count, 2).End(xlUp)).AdvancedFilter Action:=xlFilterCopy, CopyToRange:=.Cells(1, .Columns.Count), Unique:=True

For Each rfl In .Range(.Cells(1, .Columns.Count), .Cells(.Rows.Count, .Columns.Count).End(xlUp))

prsn = rfl.Text

Sheets("PullData").Select

Range("E5:P200").Select

Selection.ClearContents

Range("E5").Select

rData.AutoFilter Field:=2, Criteria1:=prsn

rData.Copy Destination:=Worksheets("PullData").Cells(5, 5)

Sheets("Pulldata").Select

Range("E:E,H:H,L:L,M:M").Select

Selection.delete Shift:=xlToLeft

Range("E5").Select

Columns("G:G").Select

Selection.Insert Shift:=xlToRight

Selection.Insert Shift:=xlToRight

Range("I5").Select

Call send_email_via_outlook

Next rfl

End With

ws.Columns(Columns.Count).ClearContents

rData.AutoFilter

Sheets("PullData").Visible = xlVeryHidden

Application.DisplayAlerts = True

End Sub



Sub send_email_via_outlook()



' Tools - Refrence - Microsoft Outlook

Dim olApp As New Outlook.Application

Dim olMail As MailItem

Dim email As String

Dim name As String

email = CStr(ThisWorkbook.Sheets("PullData").Range("F6").Value)

name = CStr(ThisWorkbook.Sheets("PullData").Range("E6").Value)

Set olMail = olApp.CreateItem(olMailItem) 

With olMail

.To = email

.CC = ""

.Subject = "Task list for " & name '<br> used to insert a line ( press enter)

.HTMLBody = "Please find the Task below <br><br> " & _

create_table(Sheets("PullData").Range("K6").CurrentRegion) & _

"</Table><br> <br>Regards<br> Yoda Learning"

.Display

.Send

End With

End Sub

 

Function create_table(rng As Range) As String

 

Dim mbody As String

Dim mbody1  As String

Dim i As Long

Dim j As Long

 

mbody = "<TABLE width=""30%"" Border=""1"", Cellspacing=""0""><TR>"

 

For i = 1 To rng.Columns.Count

mbody = mbody & "<TD width=""100"", Bgcolor=""#A52A2A"", Align=""Center""><Font Color=#FFFFFF><b><p style=""font-size:18px"">" & rng.Cells(1, i).Value & "&nbsp;</p></Font></TD>"

Next

 

' add data to the table

For i = 2 To rng.Rows.Count

mbody = mbody & "<TR>"

mbody1 = ""

For j = 1 To rng.Columns.Count

mbody1 = mbody1 & "<TD><center>" & rng.Cells(i, j).Value & "</TD>"

Next

mbody = mbody & mbody1 & "</TR>"

Next

 

create_table = mbody

End Function

Note: Please note that after pasting the code in the module and before running the code click on.

Tools –  References…

Refrence Picture-4(Picture 4)

Then choose Microsoft outlook15.0 Object Library.

Refrences VBA Project Picture-5(Picture 5)

After setting this, please press OK and then press F5 to run the code.

You will see it will send emails to all the team members automatically with their respective subject line.

Please download the file from here and play with it.

I hope you found our article useful. Also if you any doubts or questions regarding this article, feel free to post them in the comment section below.

Related Tutorials

Delete Duplicate in Excel or Remove Duplicate in Excel
November 9, 2018
Excel Formulas PDF
September 6, 2018
How To Lock Cells in Excel | Unprotect Excel
August 13, 2018
4x Faster at Excel
August 6, 2018
Separate Content of One Excel Cells into Separate Columns
August 3, 2018
How to Transpose Excel Columns to Rows | Paste Special Method
July 26, 2018
How to create sparklines in Excel
July 19, 2018
AutoSum in Excel with Shortcut
July 17, 2018
OFFSET Function in Excel
July 6, 2018
Strikethrough Shortcut in Excel & Word
July 4, 2018
INDIRECT Function with SUM, MAX, MIN & Independent Cell Value
June 29, 2018
Pivot Table Slicers In Excel
June 12, 2018
How to Split Cells in Excel using Text to Column
June 7, 2018
How to Wrap Text in Excel Automatically and Manually
June 6, 2018
How to Hide/Unhide Column in Excel
June 5, 2018
Highlight row based on cell value
June 4, 2018
Learn how to remove blank cells in Excel
June 3, 2018
How to Group Numbers, Dates & Text in Pivot table in Excel
June 1, 2018
5 Powerful Tricks to Format cells in Excel
May 31, 2018
Insert a Picture into a Cell in Excel
May 25, 2018
What is ISFORMULA Function and FORMULATEXT Function
May 21, 2018
How to Use SUBSTITUTE Function
May 21, 2018
Excel Quartile Function in Excel
May 8, 2018
How to use the Excel PERCENTILE function
May 7, 2018
Insert or Type degree symbol in Excel with Autocorrect Feature
May 7, 2018
25% Discount
No prize
All Courses at $200
Almost!
10% Discount
Free Ebook
No Prize
No luck today
Almost!
50% Discount
No prize
80% Discount
Get a chance to boost your knowledge!
Use this coupon code for any course that you wish for. 
Our in-house rules:
  • You can choose any course & redeem coupon
  • If you find any difficulty, mail us on [email protected]
  • Wheel Spin will end soon
  • Coupon code can be applied within 2 days.