keep button colour same

[redspanna]

Hi all

I have this simpe code that will change the colour of a Rounded Rectangle button from white to green once selected....

Sub RoudedRectangle13_Click()
Application.ScreenUpdating = False
ActiveSheet.Shapes("Rounded Rectangle 13").Fill.ForeColor.RGB = RGB(153, 204, 0)
ActiveSheet.Shapes("Rounded Rectangle 14").Fill.ForeColor.RGB = RGB(255, 255, 255)
ActiveSheet.Shapes("Rounded Rectangle 15").Fill.ForeColor.RGB = RGB(255, 255, 255)

End Sub

Sub RoudedRectangle14_Click()
Application.ScreenUpdating = False
ActiveSheet.Shapes("Rounded Rectangle 13").Fill.ForeColor.RGB = RGB(255, 255, 255)
ActiveSheet.Shapes("Rounded Rectangle 14").Fill.ForeColor.RGB = RGB(153, 204, 0)
ActiveSheet.Shapes("Rounded Rectangle 15").Fill.ForeColor.RGB = RGB(255, 255, 255)


End Sub
Sub RoudedRectangle15_Click()
Application.ScreenUpdating = False
ActiveSheet.Shapes("Rounded Rectangle 13").Fill.ForeColor.RGB = RGB(255, 255, 255)
ActiveSheet.Shapes("Rounded Rectangle 14").Fill.ForeColor.RGB = RGB(255, 255, 255)
ActiveSheet.Shapes("Rounded Rectangle 15").Fill.ForeColor.RGB = RGB(153, 204, 0)


End Sub

Can this code be changed so that if Rounded Rectangle 13 is selected it remains green even if Rounded Rectangle 14 or 15 is also selected and same for other two buttons

So result is whatever button or buttons are selected they remain green and NOT changed back to white if another button is selected.

Thanks in advance

 

[mikerickson]

Assign this macro to all of the shapes.

Sub AnyRoudedRectangle_Click()
    Application.ScreenUpdating = False
    With ActiveSheet.Shapes(Application.Caller).Fill.ForeColor
        If .RGB = vbWhite Then
            .RGB = RGB(153, 204, 0)
        Else
            .RGB = vbWhite
        End If
    End With
End Sub

 

[redspanna]

Perfect - thanks so much