Before Double Click Procedure
 

I have a workbook that contains a sheet tab named Menu that contains a list
of the other 15 sheet tabs that exist in this workbook. These descriptions
are located in cells D2:D16. I want to use cells A2:A16 as a double-click
prodedure whereby when the user double-clicks in the appropriate cell, it
will clear the contents plus any objects (if there are any) on the chosen
sheet tab. Below is the code I have built within the Menu worksheet---but
when I try to execute, I get a "subscript out of range" error on the row
indicated below.... Can someone help?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, Range("A2:A16")) Is Nothing Then
Dim ChosenSheet
ChosenSheet = Target.Offset(0, 3).Text
Sheets(ChosenSheet).Cells.ClearContents 'Here is the line that causes
error
On Error Resume Next
Sheets(ChosenSheet).DrawingObjects.Delete

Else
End If
End Sub

Before Double Click Procedure
 

Could be a matter of spelling or blank spaces in the sheet names... How about
this.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, Range("A2:A16")) Is Nothing Then
Dim wks as worksheet

on error resume next
set wks = worksheets(Target.Offset(0, 3).Text)
on error goto 0

if wks is nothing then
msgbox "sorry.. can't find sheet " & Target.Offset(0, 3).Text
else
wks.Cells.ClearContents
On Error Resume Next
wks.DrawingObjects.Delete
On error goto 0
End If
End Sub
--
HTH...

Jim Thomlinson


"JDaywalt" wrote:

I have a workbook that contains a sheet tab named Menu that contains a list
of the other 15 sheet tabs that exist in this workbook. These descriptions
are located in cells D2:D16. I want to use cells A2:A16 as a double-click
prodedure whereby when the user double-clicks in the appropriate cell, it
will clear the contents plus any objects (if there are any) on the chosen
sheet tab. Below is the code I have built within the Menu worksheet---but
when I try to execute, I get a "subscript out of range" error on the row
indicated below.... Can someone help?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Not Intersect(Target, Range("A2:A16")) Is Nothing Then
Dim ChosenSheet
ChosenSheet = Target.Offset(0, 3).Text
Sheets(ChosenSheet).Cells.ClearContents 'Here is the line that causes
error
On Error Resume Next
Sheets(ChosenSheet).DrawingObjects.Delete

Else
End If
End Sub