Excel training sheet to email deadlines

Jumparound

New Member
Joined
Aug 4, 2015
Messages
45
Office Version
  1. 2016
Platform
  1. Windows
Hi,

I'm trying to create a spreadsheet to track training needs and training that is out of date. What I'd like is for the sheet to email the person who's training is missing or out of date and their manager. The sheet is opened regularly so it would need to have a way of knowing it had sent an email already so people don't get bombarded with emails. Ideally though it would email again in say two weeks if the training had not been done.

Workbook is laid out as follows:
Sheet1 called Training Matrix
A10:G300 names and descriptions of training
H10:H300 the period in months that retraining is required (e.g 36, 24, 12 etc)
I9:BE9 the names of the people
I10:BE300 the dates training has been completed

Sheet2 called Emails
B3:B49 Names which match the names in I9:BE9
C3:C49 Email addresses for the people that require training (matched names in column B)
D3:D49 Managers names to match each name in column B
E3:E49 Managers email addresses to match each managers name in Column D

So the code needs to:
Check all cells from I10 to BE300 and see if any dates are within or one month before the deadline set in column H. So for example H10 is set as a period of 24 months and the person in column I has a trained date 28/06/2014 in cell I10 the code will email to tell them their training is due. If the period set in H10 is 48 months then the training would not be expired so no email would be sent.
Ideally the email sent would say "Your training in the following is out of date" then include cells A9:H9 (this is the header row) plus any rows in columns A:H that are out of date e.g. in the above example if I10 was the only out of date cell it would email A9:H9 plus A10:H10. If there were more out of date it would for example email A9:H9, A10:H10, A15:H15 and A25:H25.
It would look into the Email sheet (sheet2) to B3:B49 and match with the name from I9:BE9 (sheet1). Then send to the email in C2:C49 plus the email in E2:E49.
Finally the code would mark somewhere that it had emailed on that date and not email again until 2 weeks at least had passed.

Excel 2010 32 bit
ABCDEFGHIJKLMN
Health & Safety
Health & Safety
Health & Safety
Health & Safety
Health & Safety

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]9[/TD]
[TD="bgcolor: #808080"]Area[/TD]
[TD="bgcolor: #808080, align: center"]Procedure Code[/TD]
[TD="bgcolor: #808080, align: center"]Procedure Number[/TD]
[TD="bgcolor: #808080, align: center"]Course[/TD]
[TD="bgcolor: #808080, align: center"]In House[/TD]
[TD="bgcolor: #808080, align: center"]External[/TD]
[TD="bgcolor: #808080, align: center"]Training Provider[/TD]
[TD="bgcolor: #808080, align: center"]Retraining Period[/TD]
[TD="bgcolor: #FFFFFF"]Joe Bloggs[/TD]
[TD="bgcolor: #FFFFFF"]John Ronsons[/TD]
[TD="bgcolor: #FFFFFF"]An Other[/TD]
[TD="bgcolor: #808080, align: right"][/TD]
[TD="bgcolor: #FFFFFF"]Mr Nobody[/TD]
[TD="bgcolor: #FFFFFF"]John Jones[/TD]

[TD="align: center"]10[/TD]

[TD="align: center"]PGHS[/TD]
[TD="align: center"]100[/TD]
[TD="bgcolor: #D9D9D9, align: center"]Course 1[/TD]
[TD="align: center"]P[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]24[/TD]
[TD="bgcolor: #FFFFFF, align: center"]30/07/2015[/TD]
[TD="bgcolor: #FFFFFF, align: center"]14/06/2016[/TD]
[TD="bgcolor: #FFFFFF, align: center"]22/04/2014[/TD]
[TD="bgcolor: #808080, align: center"][/TD]
[TD="bgcolor: #FFFFFF, align: center"]19/11/2014[/TD]
[TD="bgcolor: #FFFFFF, align: center"]18/06/2014[/TD]

[TD="align: center"]11[/TD]

[TD="align: center"]PGHS[/TD]
[TD="align: center"]101[/TD]
[TD="bgcolor: #D9D9D9, align: center"]Course 2[/TD]
[TD="align: center"]P[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]12[/TD]
[TD="bgcolor: #FFFFFF, align: center"]27/09/2014[/TD]
[TD="bgcolor: #FFFFFF, align: center"]25/02/2014[/TD]
[TD="bgcolor: #FFFFFF, align: center"]26/04/2016[/TD]
[TD="bgcolor: #808080, align: center"][/TD]
[TD="bgcolor: #FFFFFF, align: center"]10/10/2014[/TD]
[TD="bgcolor: #FFFFFF, align: center"]06/12/2014[/TD]

[TD="align: center"]12[/TD]

[TD="align: center"]PGHS[/TD]
[TD="align: center"]102[/TD]
[TD="bgcolor: #D9D9D9, align: center"]Course 3[/TD]
[TD="align: center"]P[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]36[/TD]
[TD="bgcolor: #FFFFFF, align: center"]07/11/2016[/TD]
[TD="bgcolor: #FFFFFF, align: center"]14/11/2016[/TD]
[TD="bgcolor: #FFFFFF, align: center"]01/10/2014[/TD]
[TD="bgcolor: #808080, align: center"][/TD]
[TD="bgcolor: #FFFFFF, align: center"]25/09/2016[/TD]
[TD="bgcolor: #FFFFFF, align: center"]28/11/2015[/TD]

[TD="align: center"]13[/TD]

[TD="align: center"]PGHS[/TD]
[TD="align: center"]103[/TD]
[TD="bgcolor: #D9D9D9, align: center"]Course 4[/TD]
[TD="align: center"]P[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]24[/TD]
[TD="bgcolor: #FFFFFF, align: center"]07/07/2015[/TD]
[TD="bgcolor: #FFFFFF, align: center"]25/11/2015[/TD]
[TD="bgcolor: #FFFFFF, align: center"]02/12/2016[/TD]
[TD="bgcolor: #808080, align: center"][/TD]
[TD="bgcolor: #FFFFFF, align: center"]21/08/2015[/TD]
[TD="bgcolor: #FFFFFF, align: center"]30/06/2015[/TD]

[TD="align: center"]14[/TD]

[TD="align: center"]PGHS[/TD]
[TD="align: center"]104[/TD]
[TD="bgcolor: #D9D9D9, align: center"]Course 5[/TD]
[TD="align: center"]P[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]12[/TD]
[TD="bgcolor: #FFFFFF, align: center"]24/02/2016[/TD]
[TD="bgcolor: #FFFFFF, align: center"]09/02/2015[/TD]
[TD="bgcolor: #FFFFFF, align: center"]02/05/2015[/TD]
[TD="bgcolor: #808080, align: center"][/TD]
[TD="bgcolor: #FFFFFF, align: center"]12/01/2017[/TD]
[TD="bgcolor: #FFFFFF, align: center"]09/01/2016[/TD]

</tbody>
Training Matrix


For example it would email Joe Bloggs the following to Joe Bloggs and Joe Bloggs' manager:

Joe,

Your training in the following is out of date:
Excel 2010 32 bit
ABCDEFGH
Health & Safety

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
[TD="align: center"]9[/TD]
[TD="bgcolor: #808080"]Area[/TD]
[TD="bgcolor: #808080, align: center"]Procedure Code[/TD]
[TD="bgcolor: #808080, align: center"]Procedure Number[/TD]
[TD="bgcolor: #808080, align: center"]Course[/TD]
[TD="bgcolor: #808080, align: center"]In House[/TD]
[TD="bgcolor: #808080, align: center"]External[/TD]
[TD="bgcolor: #808080, align: center"]Training Provider[/TD]
[TD="bgcolor: #808080, align: center"]Retraining Period[/TD]

[TD="align: center"]14[/TD]

[TD="align: center"]PGHS[/TD]
[TD="align: center"]104[/TD]
[TD="bgcolor: #D9D9D9, align: center"]Course 5[/TD]
[TD="align: center"]P[/TD]
[TD="align: center"][/TD]
[TD="align: center"][/TD]
[TD="align: center"]12[/TD]

</tbody>
Training Matrix




I know it's a big ask but can anyone help me?
 

Excel Facts

Copy PDF to Excel
Select data in PDF. Paste to Microsoft Word. Copy from Word and paste to Excel.
Right, trying to find bits a pieces to help I've found this code online.

Code:
[COLOR=#141414][FONT=Consolas]Sub eMail()[/FONT][/COLOR]Dim lRow As Integer
Dim i As Integer
Dim toDate As Date
Dim toList As String
Dim eSubject As String
Dim eBody As String
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
End With
Sheets(1).Select
lRow = Cells(Rows.Count, 4).End(xlUp).Row
For i = 2 To lRow
toDate = Replace(Cells(i, 3), ".", "/")
  If Left(Cells(i, 5), 4) <> "Mail" And toDate - Date <= 7 Then
     Set OutApp = CreateObject("Outlook.Application")
     Set OutMail = OutApp.CreateItem(0)
        toList = Cells(i, 4)    'gets the recipient from col D
        eSubject = "Project " & Cells(i, 2) & " is due on " & Cells(i, 3)
        eBody = "Dear " & Cells(i, 1) & vbCrLf & vbCrLf & "Please update your project status."
        
        On Error Resume Next
        With OutMail
        .To = toList
        .CC = ""
        .BCC = ""
        .Subject = eSubject
        .Body = eBody
        .bodyformat = 1
        .Display   ' ********* Creates draft emails. Comment this out when you are ready
        '.Send     '********** UN-comment this when you  are ready to go live
        End With
 
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
 Cells(i, 5) = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column A"
End If
Next i
ActiveWorkbook.Save
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With [COLOR=#141414][FONT=Consolas]End Sub[/FONT][/COLOR]

This goes some way to helping but I need some help to make the necessary changes. Firstly I need to change it to not just be within 7 days as this code is but dependent on the number of months I have set in column H. I can do this with formulas (=EDATE(I10,H10) and copy these down as a helper column but would be better if it could be done in the macro.
Then this only searches one column and I need it to search several columns.
Finally it puts a note that an email has been sent but again these would need to cover several columns.

Anyone?
 
Upvote 0
Ok, I think I can work this out using multiple macros and a helper column. However I have a Run-time error '13': Type Mismatch on the following code. It stops on the this part:

Code:
If Left(Cells(i, 66), 4) <> "Mail" And Cells(i, 65) <> "" And Cells(i, 65) - Date <= 7 Then

Full code:

Code:
Sub eMail()Dim lRow As Integer
Dim i As Integer
Dim eSubject As String
Dim eBody As String
With Application
    .ScreenUpdating = False
    .EnableEvents = False
    .DisplayAlerts = False
End With
Sheets(1).Select
lRow = Cells(Rows.Count, 4).End(xlUp).Row
For i = 10 To lRow
  If Left(Cells(i, 66), 4) <> "Mail" And Cells(i, 65) <> "" And Cells(i, 65) - Date <= 7 Then
     Set OutApp = CreateObject("Outlook.Application")
     Set OutMail = OutApp.CreateItem(0)
        eSubject = "Training expired for " & Cells(i, 2) & Cells(i, 3) & Cells(i, 4)
        eBody = "Dear Chris," & vbCrLf & vbCrLf & "Please complete the following training " & Cells(i, 2) & Cells(i, 3) & " " & Cells(i, 4) & vbCrLf & vbCrLf & "Many thanks"
        
        On Error Resume Next
        With OutMail
        .To = "test@test.com"
        .CC = "test@test.com"
        .BCC = ""
        .Subject = eSubject
        .Body = eBody
        .bodyformat = 1
        .Display   ' ********* Creates draft emails. Comment this out when you are ready
        '.Send     '********** UN-comment this when you  are ready to go live
        End With
 
    On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
 Cells(i, 66) = "Mail Sent " & Date + Time 'Marks the row as "email sent in Column A"
End If
Next i
With Application
    .ScreenUpdating = True
    .EnableEvents = True
    .DisplayAlerts = True
End With
End Sub

It does everything right, just gives me an error there. Can anyone help me?
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,182
Members
453,020
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