BeforeDoubleClick 70 variations

[L7B]

Help I am pulling whats left of my hair out.

The double click works till it comes across a instruction where there is no double click line/ word relating to the code in the report.

The issue is the 2nd part below.

When I double click on WA Market Share because there is no line for Employee_Turnover on the report it does not skip over and show WA Market Share it shows Employee_Turnover instead.

The macro is made up of 70 variations over 48 reports so I dont want to be messing around with what is applicable for each report when they get broken out from the master.

This is the code that brings in the picture for display. Works perfectly.

'=================
'    EMPLOYEES
'=================
Sub Show_Employee_Engagement()
Application.ScreenUpdating = False
ChDir "N:\corpdata\Admin Gen\Scorecards\Scorecards 2011-12\0. Definitions"
    Workbooks.Open Filename:= _
    "N:\corpdata\Admin Gen\Scorecards\Scorecards 2011-12\0. Definitions\2011-12 Definitions.xlsx"
    Sheets("Employees").Select
    
Application.Goto Reference:="Employee_Engagement"
Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
Workbooks("2011-12 Definitions.xlsx").Close
    Windows("1 Rob Bransby Group Q1 2011_12.xlsm").Activate
    Range("BP4").Select
    ActiveSheet.Pictures.Paste.Select
    Selection.Name = ("EmployeeEngagement_1")
    Range("CD4").Select
    ActiveWindow.Zoom = 85
    Application.ScreenUpdating = True
  
End Sub
Sub Show_Employee_Performance_Plans()
Application.ScreenUpdating = False
ChDir "N:\corpdata\Admin Gen\Scorecards\Scorecards 2011-12\0. Definitions"
    Workbooks.Open Filename:= _
    "N:\corpdata\Admin Gen\Scorecards\Scorecards 2011-12\0. Definitions\2011-12 Definitions.xlsx"
    Sheets("Employees").Select
    Application.Goto Reference:="Employee_Performance_Plans"
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
     Workbooks("2011-12 Definitions.xlsx").Close
    Windows("1 Rob Bransby Group Q1 2011_12.xlsm").Activate
    Range("BP4").Select
    ActiveSheet.Pictures.Paste.Select
    Selection.Name = ("EmployeePerformancePlans_1")
    Range("CD4").Select
    ActiveWindow.Zoom = 85
    Application.ScreenUpdating = True
End Sub

Sub Show_Performance_Reviews_Completion()
Application.ScreenUpdating = False
ChDir "N:\corpdata\Admin Gen\Scorecards\Scorecards 2011-12\0. Definitions"
    Workbooks.Open Filename:= _
    "N:\corpdata\Admin Gen\Scorecards\Scorecards 2011-12\0. Definitions\2011-12 Definitions.xlsx"
    Sheets("Employees").Select
    Application.Goto Reference:="Performance_Reviews_Completion"
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
     Workbooks("2011-12 Definitions.xlsx").Close
    Windows("1 Rob Bransby Group Q1 2011_12.xlsm").Activate
    Range("BP4").Select
    ActiveSheet.Pictures.Paste.Select
    Selection.Name = ("PerformanceReviewsCompletion_1")
    Range("CD4").Select
    ActiveWindow.Zoom = 85
    Application.ScreenUpdating = True
End Sub
Sub Show_Employee_Turnover()
Application.ScreenUpdating = False
ChDir "N:\corpdata\Admin Gen\Scorecards\Scorecards 2011-12\0. Definitions"
    Workbooks.Open Filename:= _
    "N:\corpdata\Admin Gen\Scorecards\Scorecards 2011-12\0. Definitions\2011-12 Definitions.xlsx"
    Sheets("Employees").Select
    
Application.Goto Reference:="Employee_Turnover"
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
     Workbooks("2011-12 Definitions.xlsx").Close
    Windows("1 Rob Bransby Group Q1 2011_12.xlsm").Activate
    Range("BP4").Select
    ActiveSheet.Pictures.Paste.Select
    Selection.Name = ("EmployeeTurnover_1")
    Range("CD4").Select
    ActiveWindow.Zoom = 85
    Application.ScreenUpdating = True
End Sub
Sub Show_Absenteeism_()
Application.ScreenUpdating = False
ChDir "N:\corpdata\Admin Gen\Scorecards\Scorecards 2011-12\0. Definitions"
    Workbooks.Open Filename:= _
    "N:\corpdata\Admin Gen\Scorecards\Scorecards 2011-12\0. Definitions\2011-12 Definitions.xlsx"
    Sheets("Employees").Select
    Application.Goto Reference:="Abenteeism_"
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
     Workbooks("2011-12 Definitions.xlsx").Close
    Windows("1 Rob Bransby Group Q1 2011_12.xlsm").Activate
    Range("BP4").Select
    ActiveSheet.Pictures.Paste.Select
    Selection.Name = ("Absenteeism_1")
    Range("CD4").Select
    ActiveWindow.Zoom = 85
    Application.ScreenUpdating = True
End Sub

'=================
'    MEMBERS
'=================
Sub Show_WA_Market_Share()
Application.ScreenUpdating = False
ChDir "N:\corpdata\Admin Gen\Scorecards\Scorecards 2011-12\0. Definitions"
    Workbooks.Open Filename:= _
    "N:\corpdata\Admin Gen\Scorecards\Scorecards 2011-12\0. Definitions\2011-12 Definitions.xlsx"
    Sheets("Members").Select
    Application.Goto Reference:="WA_Market_Share"
    Selection.CopyPicture Appearance:=xlScreen, Format:=xlPicture
    Workbooks("2011-12 Definitions.xlsx").Close
    Windows("1 Rob Bransby Group Q1 2011_12.xlsm").Activate
    Range("BP4").Select
    ActiveSheet.Pictures.Paste.Select
    Selection.Name = ("WAMarketShare_1")
    Range("CD4").Select
    ActiveWindow.Zoom = 85
    Application.ScreenUpdating = True
End Sub

2nd Part

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Create_Shape_CLOSE_KPI_DEFINITION
'=================
'    EMPLOYEES
'=================
On Error Resume Next
If Range("EmployeeEngagement") Is Nothing Then Exit Sub
If Not Intersect(Target, Range("EmployeeEngagement")) Is Nothing Then
On Error GoTo 0
    Show_Employee_Engagement
   
On Error Resume Next
ElseIf Range("EmployeePerformancePlans") Is Nothing Then Exit Sub
ElseIf Not Intersect(Target, Range("EmployeePerformancePlans")) Is Nothing Then
On Error GoTo 0
   Show_Employee_Performance_Plans
 
On Error Resume Next
ElseIf Range("PerformanceReviewsCompletion") Is Nothing Then Exit Sub
ElseIf Not Intersect(Target, Range("PerformanceReviewsCompletion")) Is Nothing Then
On Error GoTo 0
    Show_Performance_Reviews_Completion
   
'On Error Resume Next
'ElseIf Range("EmployeeTurnover") Is Nothing Then
'ElseIf Not Intersect(Target, Range("EmployeeTurnover")) Is Nothing Then
'On Error GoTo 0
   'Show_Employee_Turnover
  
'On Error Resume Next
'ElseIf Range("Absenteeism_") Is Nothing Then
'ElseIf Not Intersect(Target, Range("Absenteeism_")) Is Nothing Then
'On Error GoTo 0
   'Show_Absenteeism_

On Error Resume Next
ElseIf Range("WAMarketShare") Is Nothing Then Exit Sub
ElseIf Not Intersect(Target, Range("WAMarketShare")) Is Nothing Then
On Error GoTo 0
    Show_WA_Market_Share

Thanks

 

[GlennUK]

Cross-posted:

http://www.ozgrid.com/forum/showthread.php?t=159176