Call Sub Routine by selecting Row

[Av8tordude]

The code below creates a shape (i.e. Message) when I click on another shape (i.e. Shape A) (works fine). However, I get an error when I just select the row shape A is located. How can I run this sub routine by selecting the row Shape A is located?

Dim r As Range, Cel As Range
Dim LRow As Long
Dim Shp As Shape

Set Shp = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 112.5, 112.5, 115, 1)
Set r = ActiveSheet.Shapes(Application.Caller).TopLeftCell
Set Cel = r.Offset(0, 0)

With Shp
    .Name = "Callout"
    .TextFrame.Characters.Text = r.Offset(0, 0).Comment.Text
    .Left = Cel.Left - .Width
    .Top = Cel.Offset().Top
    .Line.Visible = msoFalse
    .TextFrame2.AutoSize = msoAutoSizeShapeToFitText
    .OnAction = "DelCallout"
End With

 

[Fluff]

Do you still want to be able to run the sub by clicking the shape?

 

[Av8tordude]

Yes

 

[Fluff]

In that case which column is the shape located in?

 

[Av8tordude]

Column S

 

[Fluff]

Ok, how about

Set Shp = ActiveSheet.Shapes.AddShape(msoShapeRoundedRectangle, 112.5, 112.5, 115, 1)
If IsError(Application.Caller) Then
   Set r = Cells(ActiveCell.Row, "S")
Else
   Set r = ActiveSheet.Shapes(Application.Caller).TopLeftCell
End If
Set Cel = r.Offset(0, 0)

 

[Av8tordude]

Excellent...Thank you Fluff. I knew I had to use an if statement, but I kept hitting the wall trying to figure out getting around not using the application.caller.

Again...Thank you for helping me.

 

[Fluff]

You're welcome & thanks for the feedback.