Getting frustrated - I know the below is UGLY
Essentially, I have a list of supervisors and a # category that tells me what information they are missing. I want to find which employees they are missing reviews and/or goal forms for, create an email, and email them the names of the employees who are missing data (with some additional language)
Can anyone help? I'm sure there will be questions in order to provide solutions, but... I'm frazzled looking at this at the moment
Essentially, I have a list of supervisors and a # category that tells me what information they are missing. I want to find which employees they are missing reviews and/or goal forms for, create an email, and email them the names of the employees who are missing data (with some additional language)
Can anyone help? I'm sure there will be questions in order to provide solutions, but... I'm frazzled looking at this at the moment
Code:
Private Sub Email2()
Dim Subject As String
Dim oApp As Object, _
oMail As Object, _
WB As Workbook, _
FileName As String
Dim SupvName As String
Dim c
Dim z
Dim d
'0 is All Done
'1 is Training
'3 is Reviews
'4 is Training & Reviews
'5 is Goals
'6 is Training & Goals
'8 is Reviews & Goals
'9 is Training, Reviews, & Goals
'Turn off screen updating
Application.ScreenUpdating = False
With Worksheets("Master Spvr").Range("I2")
Range("I2").Activate
SupvName = ActiveCell.Offset(0, -8).Value
For Each c In Range("I2:I8")
If ActiveCell.Value = 1 Then
'Create and show the outlook mail item
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
.To = ActiveCell.Offset(0, -8)
.Subject = "Performance Management - Pending Items"
.Body = "You have not completed the mandatory Supervisor Training module on Performance Management. "
.Display
End With
ElseIf ActiveCell.Value = 3 Then
With Worksheets("No Review").Range("B3:B6")
Worksheets("No Review").Select
Range("B3").Select
For Each z In Range("B3:B6")
If Selection = SupvName Then
ActiveCell.Offset(0, -1).Select
Selection.Copy
If SheetExists2(SupvName) Then
Worksheets(SupvName).Select
End If
Selection.End(xlDown).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
Selection.End(xlUp).Select
End If
'HERE IS WHERE IT GETS STUCK AND DOES NOT ROTATE THROUGH THE LIST OF EMPLOYEES ON THE 'NO REVIEW' WORKSHEET
ActiveCell.Offset(1, 0).Select
Next z
End With
With Worksheets("Master Spvr")
Worksheets("Master Spvr").Activate
'Create and show the outlook mail item
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
.To = ActiveCell.Offset(0, -7)
.Subject = "Performance Management - Pending Items"
.Body = "You have reviews to do"
.Display
End With
End With
Else:
'Create and show the outlook mail item
Set oApp = CreateObject("Outlook.Application")
Set oMail = oApp.CreateItem(0)
With oMail
.To = ActiveCell.Offset(0, -7)
.Subject = "Performance Management - Pending Items"
.Body = "Sorry"
.Display
End With
End If
ActiveCell.Offset(1, 0).Select
Next c
'Restore screen updating and release Outlook
Application.ScreenUpdating = True
Set oMail = Nothing
Set oApp = Nothing
End With
End Sub