Streamline VBA to Change shape color on click in excel

Question

I have a ‘form’ that contains set of questions on a worksheet (note this is not a userform and I don’t want to use one). Some answers are yes/no, others have multiple answers such as quantity (ie and the answer may be 1 or 2 or 3 or 4 etc).

The design of the ‘form’ on this worksheet calls for these answers to be shapes which the user clicks like a button to select their answer - Pls note I do not want to use Command buttons.

In this simple example I have 2 rectangle shapes one name “yes” and one name “no” When user clicks “yes”, the color fill of the shape changes to blue (and the “no” shape stays white). If user clicks “no” , the “no” shape turns blue, and “yes” goes white. It also populates and answer in A1 in this example.

I use the following code which works fine (although im sure could be cut down somewhat) however the problem comes when I need to replicate this code multiple times. For example, if I have a question that has multiple answers like Quantity (answers could be 1 or 2 or 3 or 4 or 5) then each macro (ie for button “1” ) needs and “active” piece of coder, and a “non active” piece to designate colours to the active shape and all the other non active shapes. This is very repetitive and the code quickly becomes verbose. Im hoping there is a way to keep the formatting (fill color, text color etc) in a separate macro such as “Sub Active” and “Sub Non_Active” rather than having to repeat it time after time. I’ve tried to use “Call” to grab the macro containing the formatting (like Call Active) but keep getting an error.

Sub yes_button()

'active
ActiveSheet.Shapes("yes").Select
ActiveSheet.Shapes("yes").Fill.ForeColor.RGB = RGB(85, 142, 213)                          ' fill: dark blue color
ActiveSheet.Shapes("yes").Line.BackColor.RGB = RGB(198, 217, 241)                        ' border: light blue color
ActiveSheet.Shapes("yes").TextFrame.Characters.Font.Color = RGB(255, 255, 255)       '         text: white color
Range("A1").Formula = "YES" ' fills cell with button value

' nonactive
ActiveSheet.Shapes("no").Select
ActiveSheet.Shapes("no").Fill.ForeColor.RGB = RGB(255, 255, 255)                  '     fill: light blue color
ActiveSheet.Shapes("no").Line.BackColor.RGB = RGB(198, 217, 241)                  ' border: light blue color
ActiveSheet.Shapes("no").TextFrame.Characters.Font.Color = RGB(85, 142, 213)     ' text: dark blue color



End Sub

Sub no_button()

'active
ActiveSheet.Shapes("no").Select
ActiveSheet.Shapes("no").Fill.ForeColor.RGB = RGB(85, 142, 213)                       '     fill: dark blue color
ActiveSheet.Shapes("no").Line.BackColor.RGB = RGB(198, 217, 241)                      '    border: light blue color
ActiveSheet.Shapes("no").TextFrame.Characters.Font.Color = RGB(255, 255, 255)       ' text: white color
Range("A1").Formula = "NO" ' fill scell with button value
' nonactive

ActiveSheet.Shapes("yes").Select
ActiveSheet.Shapes("yes").Fill.ForeColor.RGB = RGB(255, 255, 255)                  ' fill: light blue color
ActiveSheet.Shapes("yes").Line.BackColor.RGB = RGB(198, 217, 241)                  '     border: light blue color
ActiveSheet.Shapes("yes").TextFrame.Characters.Font.Color = RGB(85, 142, 213)     '     text: dark blue color

End Sub

Would appreciate any suggestions. Thankyou

Answer 1

So, after taking some time away from this Ive began using the following. In this example I have 2 shapes (squares)- "radio_1" and "radio_2". I also have a cell that populates with an output ie "Radio 1 selected". In Each Shape I have the font set to Wingdings and a white colored "tick" in each shape.

I have also created separate modules - "radio" and "style" .The radio module contains the code that identifies which shape was clicked and then calls the relevant styling macro (active/inactive) from the "style" module. This is code has reduced the original code I had above greatly and is much easier to manipulate but it you can think of any other ways to make this even more succinct id love to see it (still learning!)

Sub radio_btn_grp_1()

Dim wb As Workbook
Dim ws As Worksheet
Dim oShape1 As Shape

Set wb = ActiveWorkbook
Set ws = wb.Sheets("radio_btns")
Set oShape1 = ws.Shapes(CallingShapeName)

CallingShapeName = ws.Shapes(Application.Caller).Name

If CallingShapeName = "radio_1" Then
Call Active

ws.Range("radio_btn_val_1").Value = "Radio 1 Selected"

Dim arShapes1() As Variant
Dim objRange1 As Object
arShapes1 = Array("radio_2")
Set objRange1 = ws.Shapes.Range(arShapes1)

With objRange1
    .Line.ForeColor.RGB = RGB(0, 153, 153)
    .Fill.ForeColor.RGB = RGB(255, 255, 255)
    .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)

End With

Else

If CallingShapeName = "radio_2" Then

    Call Active

    ws.Range("radio_btn_val_1").Value = "Radio 2 selected"

    Dim arShapes2() As Variant
    Dim objRange2 As Object
    arShapes2 = Array("radio_1")
    Set objRange2 = ws.Shapes.Range(arShapes2)

    With objRange2
        .Line.ForeColor.RGB = RGB(0, 153, 153)
        .Fill.ForeColor.RGB = RGB(255, 255, 255)
        .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)

    End With
End If
End If

End Sub

And the style module that changes the colors of the selected/not selected shape (active/non active) is :

Sub Active() ' Change colors of active checkbox to green (and add "tick")

Dim wb As Workbook
Dim ws As Worksheet
Dim oShape1 As Shape

Set wb = ActiveWorkbook
Set ws = wb.Sheets("radio_btns")
Set oShape1 = ws.Shapes(CallingShapeName)

CallingShapeName = ws.Shapes(Application.Caller).Name




    With oShape1
    .Line.ForeColor.RGB = RGB(0, 153, 153)
    .Fill.ForeColor.RGB = RGB(0, 153, 153)
    .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
    .TextFrame2.TextRange.Characters.Text = "ü"                             ' add tick - ensure font is windings
End With
End Sub

Sub Inactive()  ' Change colors of active checkbox to white (and remove "tick")

Dim wb As Workbook
Dim ws As Worksheet
Dim oShape1 As Shape

Set wb = ActiveWorkbook
Set ws = wb.Sheets("radio_btns")
Set oShape1 = ws.Shapes(CallingShapeName)

CallingShapeName = ws.Shapes(Application.Caller).Name
With oShape1
    .Line.ForeColor.RGB = RGB(175, 171, 171)
    .Fill.ForeColor.RGB = RGB(255, 255, 255)
    .TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
    .TextFrame2.TextRange.Characters.Text = ""                                  ' clear tick
End With
End Sub

This works for me and ive adapted it to replicate checkboxes , toggle switches, tabs etc. Why you may ask??? I find this far more flexible form a design perspective that AciveX Controls. Sometimes i build sheets that are similar in look and feel to websites and this way i can make similar functionality and design that is available in current web design.

Would love to hear if this can be improved further. Cheers

Answer 2

yes, you're right, you could write a Sub with your shape as an input and eventually fill it with the "yes" and "no" events. E.g. ClickOnButton MyShape, YesNo where YesNo can be a flag that triggers one of the events. Then you could call that Sub for each button.

I also would suggest the use of some Withs: With Activesheet.MyShape is going to do fine. Finally, please do not use the .Select. There are tons of reason not to do that and most of all the select won't do really anything in your code... Well yeah, slow it down.

I'll give you an example to try to explain better: You could write a subroutine giving a Shape and a Boolean (for example) as an Input (that would be the YesNo variable). Inside the subroutine you could write the 2 different behaviours conditionally (If ... Else ... End If) to the YesNo variable (or, do we want to call it GreenRed/ActiveInactive?). In both conditions you can write whatever you want. The following can be used for both "yes" and "no" buttons.

Sub Example(YourShape As Shape, GreenRed as Boolean)

    If GreenRed = True Then ' Say we want in this case an "active" button
        With YourShape
            .Fill.ForeColor.RGB = RGB(85, 142, 213)
            .Line.BackColor.RGB = RGB(198, 217, 241)
            .TextFrame.Characters.Font.Color = RGB(255, 255, 255)
        End With
    Else
        With YourShape
            .Fill.ForeColor.RGB = RGB(255, 255, 255)
            .Line.BackColor.RGB = RGB(198, 217, 241)
            .TextFrame.Characters.Font.Color = RGB(85, 142, 213) 
        End With
    End If

End Sub

You can then in your Main program write Example ActiveSheet.Shapes("yes"), True to get a button activate itself and Example ActiveSheet.Shapes("no"), False to deactivate the other.