Testing to see if a cell has a shape

ss123

New Member
Joined
Mar 4, 2014
Messages
21
Hello,

I am hoping you can help me or point me towards a solution for this problem.

I have a worksheet in which there might be shapes within various cells. I have learned of a way to autorun a macro simply by clicking on a cell (either through this site or StackOverflow) by right-clicking the sheet tab and choosing view code and then putting in this code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
<code>
end sub

Using this, is there a code sequence that I can add that will find out if there is a shape in the cell and if there is, return to me the shape's name? I will then run code on my own to do different things depending on which shape is in the cell.

StackOverflow had a normal subroutine with this code as follows that appeared to work but only if you clicked on a shape in the cell (and attached the macro to the shape). I want a cell-based solution. Their code was:

Sub GetName()
Dim Nme As String
Nme = ActiveSheet.Shapes(Application.Caller).name
<code>
End Sub

I want to make a distinction here. The above GetName code seems to only work when the code is applied to a shape. But I am not looking for that type of solution. I will be using the cell reference in my code to grab values from other sheets in the same workbook. So clicking on a shape instead of a cell will not serve my purposes. As well, bear in mind that most cells will not have shapes in them. I just want to cover those few that might have shapes. As such, I will need to logically determine if there is a shape in a cell before getting its name or else, that will of course give me errors.

Another note to consider. My shapes will be within a cell. There will be no cases of a shape being astride 2 or more cells. The shapes are small and the cells are large.

Thanks...
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
65,938
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   Dim Shp As Shape
   
   For Each Shp In Me.Shapes
      If Shp.TopLeftCell.Address = Target.Address Then
         MsgBox Shp.Name
         Exit For
      End If
   Next Shp
End Sub
 
Solution

ss123

New Member
Joined
Mar 4, 2014
Messages
21
Big grin:biggrin:. That seems to have done what I was looking for. Thanks for the very quick and very good solution.
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
65,938
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 

Forum statistics

Threads
1,148,160
Messages
5,745,123
Members
423,927
Latest member
Pra56

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top