Sub SelectActiveAgentTIX_2_MGMNT_2019() Workbooks("ESD_QA_2019.xlsx").Activate Sheets("JAN_TIX").Select Range("D" & Selection.row & "," & "G" & Selection.row & ":H" & Selection.row & "," & "K" & Selection.row & ":L" & Selection.row & "," & "P" & Selection.row & ":AG" & Selection.row).Select Selection.Copy Sheets("E2M4TIX").Visible = True Sheets("E2M4TIX").Select Range("B6").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ True, Transpose:=True With Selection .HorizontalAlignment = xlLeft .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With With Selection.Borders(xlEdgeRight) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With With Selection.Borders(xlEdgeLeft) .LineStyle = xlContinuous .ColorIndex = 0 .TintAndShade = 0 .Weight = xlThin End With 'SCORE Fix Formula Range("G30").Select Selection.Copy Range("B27").Select Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False 'Clear Remarks and Comments Section Range("A2,A32:B39,A3:B3").Select Selection.ClearContents 'Auto load default values for each No Criterias Range("A34") = Range("F34").FormulaR1C1 Range("A36") = Range("F36").FormulaR1C1 Range("A38") = Range("F38").FormulaR1C1 Range("A40") = Range("F40").FormulaR1C1 'Loop Feedback Comments populate Call GetSearchArrayTIX_MGMNT_2019("No", Range("B11:B26")) Application.Calculate 'Check if 100%, add good job message If Range("B27").Value = 100 Then Range("A32") = Range("G9") End If 'Get Back to Ticket Auditing Next Agent Windows("ESD_QA_2019.xlsx:2").Activate Sheets("Progress&Results").Select Windows("ESD_QA_2019.xlsx:1").Activate Sheets("E2M4TIX").Select End Sub Sub Email_TIX_TO_MGMNT_2019() Dim strHtml As String strHtml = " " Dim AWorksheet As Worksheet Dim Sendrng As Range Dim rng As Range Sheets("E2M4TIX").Visible = True Set Sendrng = Worksheets("E2M4TIX").Range("A1:B57") 'Set specific Range to be Copied to the Email Set AWorksheet = ActiveSheet 'Remember the Active Sheet 'Disable Application features to increase speed With Application .ScreenUpdating = False .EnableEvents = False End With With Sendrng 'Select the worksheet with the range you want to send .Parent.Select 'Remember the ActiveCell on that worksheet Set rng = ActiveCell 'Select the range you want to mail .Select 'Create the mail and send it If ActiveWorkbook.EnvelopeVisible = False Then 'Toggle Email if it's not displayed already ActiveWorkbook.EnvelopeVisible = True With .Parent.MailEnvelope 'Add a intro to the email before mailing the selected range. '.Introduction = "Hello " & Range("H7") & "," & vbNewLine & vbNewLine & "I recently audited one of your tickets. It is ticket # " & Range("B9") & "." & vbNewLine & "Please take the time to review it when you can." 'Set email properties (to,cc,subject..etc) With .Item .to = "luc.trudel3@canada.ca" '.To = "Blanchard, Natalie (SSC/SPC);" '.CC = "Desjardins6, Eric (SSC/SPC);Dubois, Alex (SSC/SPC);ESD TL / BSE CE (SSC/SPC)" .Subject = "QA - Ticket Feedback - " & Range("B9") .Recipients.ResolveAll .HTMLBody = strHtml End With End With Else 'Toggle Email if it's been displayed already ActiveWorkbook.EnvelopeVisible = False End If End With End Sub Sub Email_TIX_TO_MGMNT_FORCEBGWHITE_2019() Dim AWorksheet As Worksheet Dim Sendrng As Range Dim rng As Range Sheets("E2M4TIX_FORCEBGWHITE").Visible = True Set Sendrng = Worksheets("E2M4TIX_FORCEBGWHITE").Range("A1:B57") 'Set specific Range to be Copied to the Email Set AWorksheet = ActiveSheet 'Remember the Active Sheet 'Disable Application features to increase speed With Application .ScreenUpdating = False .EnableEvents = False End With With Sendrng 'Select the worksheet with the range you want to send .Parent.Select 'Remember the ActiveCell on that worksheet Set rng = ActiveCell 'Select the range you want to mail .Select 'Create the mail and send it If ActiveWorkbook.EnvelopeVisible = False Then 'Toggle Email if it's not displayed already ActiveWorkbook.EnvelopeVisible = True With .Parent.MailEnvelope 'Add a intro to the email before mailing the selected range. '.Introduction = "Hello " & Range("H7") & "," & vbNewLine & vbNewLine & "I recently audited one of your tickets. It is ticket # " & Range("B9") & "." & vbNewLine & "Please take the time to review it when you can." 'Set email properties (to,cc,subject..etc) With .Item '.To = "luc.trudel3@canada.ca" .to = "Blanchard, Natalie (SSC/SPC);" .CC = "Desjardins6, Eric (SSC/SPC);Dubois, Alex (SSC/SPC);ESD TL / BSE CE (SSC/SPC)" .Subject = "QA - Ticket Feedback - " & Range("B9") '.Body = "" .Recipients.ResolveAll End With End With Else 'Toggle Email if it's been displayed already ActiveWorkbook.EnvelopeVisible = False End If End With End Sub Sub Back2TIX_MGMNT_2019() Windows("ESD_QA_2019.xlsx:1").Activate Sheets("JAN_TIX").Select Sheets("E2M4TIX").Visible = False End Sub Sub Back2TIX_MGMNT_FORCEBGWHITE_2019() Windows("ESD_QA_2019.xlsx:1").Activate Sheets("JAN_TIX").Select Sheets("E2M4TIX_FORCEBGWHITE").Visible = False End Sub Sub Back2TIXAndClear_MGMNT_2019() Windows("ESD_QA_2019.xlsx:1").Activate Sheets("E2A4TIX").Visible = False Call ResetFilterREM_AfterEmailSent_2019 End Sub Sub Back2TIXAndClear_FORCEBGWHITE_2019() Windows("ESD_QA_2019.xlsx:1").Activate Sheets("E2A4TIX_FORCEBGWHITE").Visible = False Call ResetFilterREM_AfterEmailSent_2019 End Sub