Excel training sheet to email deadlines

[Jumparound]

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

	A	B	C	D	E	F	G	H	I	J	K	L	M	N
9	Area	Procedure Code	Procedure Number	Course	In House	External	Training Provider	Retraining Period	Joe Bloggs	John Ronsons	An Other		Mr Nobody	John Jones
10	Health & Safety	PGHS	100	Course 1	P			24	30/07/2015	14/06/2016	22/04/2014		19/11/2014	18/06/2014
11	Health & Safety	PGHS	101	Course 2	P			12	27/09/2014	25/02/2014	26/04/2016		10/10/2014	06/12/2014
12	Health & Safety	PGHS	102	Course 3	P			36	07/11/2016	14/11/2016	01/10/2014		25/09/2016	28/11/2015
13	Health & Safety	PGHS	103	Course 4	P			24	07/07/2015	25/11/2015	02/12/2016		21/08/2015	30/06/2015
14	Health & Safety	PGHS	104	Course 5	P			12	24/02/2016	09/02/2015	02/05/2015		12/01/2017	09/01/2016

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</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

	A	B	C	D	E	F	G	H
9	Area	Procedure Code	Procedure Number	Course	In House	External	Training Provider	Retraining Period
14	Health & Safety	PGHS	104	Course 5	P			12

<colgroup><col style="width: 25pxpx"><col><col><col><col><col><col><col><col></colgroup><thead>
</thead><tbody>
</tbody>

Training Matrix​

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

 

[Jumparound]

Can anyone help me out with this?

 

[Jumparound]

Right, trying to find bits a pieces to help I've found this code online.

[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?

 

[Jumparound]

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:

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

Full 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?