Code not working for some shapes

[Banana235]

Hi all,

I tried to use this code to change the color of each clicked square.

Sub MyShape_Click()
On Error Resume Next
  Dim sh As Shape
   Set sh = ActiveSheet.Shapes(Application.Caller)
   If sh.Fill.ForeColor.RGB = RGB(182, 230, 104) Then
        sh.Fill.ForeColor.RGB = RGB(255, 255, 163)
   ElseIf sh.Fill.ForeColor.RGB = RGB(255, 255, 163) Then
            sh.Fill.ForeColor.RGB = RGB(89, 230, 249)
       ElseIf sh.Fill.ForeColor.RGB = RGB(89, 230, 249) Then
                sh.Fill.ForeColor.RGB = RGB(255, 89, 230)
            ElseIf sh.Fill.ForeColor.RGB = RGB(255, 89, 230) Then
                    sh.Fill.ForeColor.RGB = RGB(237, 125, 49)
                ElseIf sh.Fill.ForeColor.RGB = RGB(237, 125, 49) Then
                        sh.Fill.ForeColor.RGB = RGB(0, 0, 0)
                    ElseIf sh.Fill.ForeColor.RGB = RGB(0, 0, 0) Then
                            sh.Fill.ForeColor.RGB = RGB(182, 230, 104)
                        Else
            sh.Fill.ForeColor.RGB = RGB(0, 0, 0)
  End If
End Sub

It worked perfectly for the first squares, but the squares that are orange in the image below resulted in an error when clicked.
The line
Set sh = ActiveSheet.Shapes(Application.Caller)
was marked as erroneous, but I can't tell why it's not working for the other squares.

 

[rlv01]

Try this.

Sub MyShape_Click()
    Dim sh As Shape
    
    On Error Resume Next
    Set sh = ActiveSheet.Shapes(Application.Caller)
    On Error GoTo 0
    
    If Not sh Is Nothing Then
        If sh.Fill.ForeColor.RGB = RGB(182, 230, 104) Then
            sh.Fill.ForeColor.RGB = RGB(255, 255, 163)
        ElseIf sh.Fill.ForeColor.RGB = RGB(255, 255, 163) Then
            sh.Fill.ForeColor.RGB = RGB(89, 230, 249)
        ElseIf sh.Fill.ForeColor.RGB = RGB(89, 230, 249) Then
            sh.Fill.ForeColor.RGB = RGB(255, 89, 230)
        ElseIf sh.Fill.ForeColor.RGB = RGB(255, 89, 230) Then
            sh.Fill.ForeColor.RGB = RGB(237, 125, 49)
        ElseIf sh.Fill.ForeColor.RGB = RGB(237, 125, 49) Then
            sh.Fill.ForeColor.RGB = RGB(0, 0, 0)
        ElseIf sh.Fill.ForeColor.RGB = RGB(0, 0, 0) Then
            sh.Fill.ForeColor.RGB = RGB(182, 230, 104)
        Else
            sh.Fill.ForeColor.RGB = RGB(0, 0, 0)
        End If
    End If
End Sub

 

[Banana235]

Try this.

Sub MyShape_Click()
    Dim sh As Shape
   
    On Error Resume Next
    Set sh = ActiveSheet.Shapes(Application.Caller)
    On Error GoTo 0
   
    If Not sh Is Nothing Then
        If sh.Fill.ForeColor.RGB = RGB(182, 230, 104) Then
            sh.Fill.ForeColor.RGB = RGB(255, 255, 163)
        ElseIf sh.Fill.ForeColor.RGB = RGB(255, 255, 163) Then
            sh.Fill.ForeColor.RGB = RGB(89, 230, 249)
        ElseIf sh.Fill.ForeColor.RGB = RGB(89, 230, 249) Then
            sh.Fill.ForeColor.RGB = RGB(255, 89, 230)
        ElseIf sh.Fill.ForeColor.RGB = RGB(255, 89, 230) Then
            sh.Fill.ForeColor.RGB = RGB(237, 125, 49)
        ElseIf sh.Fill.ForeColor.RGB = RGB(237, 125, 49) Then
            sh.Fill.ForeColor.RGB = RGB(0, 0, 0)
        ElseIf sh.Fill.ForeColor.RGB = RGB(0, 0, 0) Then
            sh.Fill.ForeColor.RGB = RGB(182, 230, 104)
        Else
            sh.Fill.ForeColor.RGB = RGB(0, 0, 0)
        End If
    End If
End Sub

That doesn't work.
What is

If Not sh Is Nothing

supposed to do?
It does work equally good as the original code, just not for the squares that have a number higher than 99.

 

[rlv01]

That doesn't work.
What is

If Not sh Is Nothing

supposed to do?
It does work equally good as the original code, just not for the squares that have a number higher than 99.

I realize that you are new to the forum, so bear in mind that a response of "that doesn't work" without an explanation or example of how it does not work does not give me anywhere to go.

The purpose of If Not sh Is Nothing then is to ignore illegal results from Application.Caller. The way you are using application.caller,

sh = ActiveSheet.Shapes(Application.Caller)

requires it to resolve to a valid member of the shapes collection if it is to work as you intended.

The test shape I set up appears to change color as your code indicates. What is the error you get (specific number and description) and what do you have to do to re-create the error?

 

[Banana235]

Hi rlv,

Thanks for the help.

The error I'm getting is:

"Error -2147024809 (80070057) during execution.
The item with the given name is not found."

I think the code
Set sh = ActiveSheet.Shapes(Application.Caller)
doesn't work with shapes that have a name longer than 30 characters.

When I edit the name of the shape and give it a shorter name, the code works.

 

[Fluff]

Application.Caller is limited to 30 characters, so you will need to change the name of those shapes.

 

[Jon Peltier]

When I insert a shape like yours, it is automatically named "Rectangle: Rounded Corners 1" which is 28 characters long.

But you should always give shapes a much more descriptive name. "Pushbutton1" might be better, or "ColorButton1", and these are short enough not to run into the maximum length problem.