Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

How to change the color of a button and assign value to it when choosing, and in parallel the other buttons will change to the same color in Excel VBA

0

I have 5 criteria. Each criteria has 5 different buttons (different color) represent for each option with a certain score for each.

How to remain the color of a desired button and assign value to it when choosing, and in parallel the other buttons will change to the same color (grey for instance)? And at the same time, the comment cell will appear the describe text for the option that I chose

After choosing the option for all criteria, we will have the overall score below

Here is the mockup for your reference: 

Thanks a lot in advance for your help.

Much appreciated.

Answer
Discuss

Discussion

Hi Joe and welcome to the Forum 

Can't see your mock up since you can only upload Excel files (using the Add Files... button when you edit your original question).

Please edit your question to add a. xlsm file (with test data) 
John_Ru (rep: 6102) Dec 16, '21 at 3:09 am
Hello John, I modified my post & add a sample excel. Thank you
joevn93 (rep: 4) Dec 16, '21 at 3:31 am
Joe. I've added an answer but please note that ordinarily we would not create all the code needed for a project you've imagined- we'd expect you to attempt to do the coding and ask simpler questions when you get into trouble. Consider this a one-off Christmas gift from a stranger!
John_Ru (rep: 6102) Dec 16, '21 at 8:32 am
Add to Discussion

Answers

0
Selected Answer

Joe

In the First revised sheet attached. there's a single macro that does all the work (with comments). It works out which option was picked then shades out the other buttons in that row and puts the score in the cell behind the chosen button:

Sub GreyOptions(ShpNo As Integer, Rw As Integer)

Dim Clrs As Variant, Shd As Long, OptNo as Integer

' put shape colours in the array
Clrs = Array(5606641, 13337440, 4638719, 6404225, 13395711)
'set the shade out colour
Shd = 11513775

For n = 1 To 5 'loop through options
    OptNo = 1 + (ShpNo - 3) Mod 5 'determine option number picked
    With Sheet1.Shapes("Flowchart: Process " & ShpNo + n - OptNo) 'pick shape in loop
        If n <> OptNo Then
            .Fill.Solid
            .Fill.ForeColor.RGB = Shd 'fill shapes as Shd colour
            .TextFrame.Characters.Font.Color = vbWhite ' set font white
            .TopLeftCell.Value = "" 'clear any value in cell behind
            Else:
            .Fill.ForeColor.RGB = Clrs((n - 1) Mod 5) ' leave colour as usual
            .TextFrame.Characters.Font.Color = vbBlack ' set font black
            Select Case Rw 'look up scores and store in cell behind option
                Case 5
                   .TopLeftCell.Value = Sheet2.Range("A1").Offset(OptNo, 1) 'get score
                   Cells(Rw, 10).Value = Sheet2.Range("A1").Offset(OptNo, 2) 'add comment
                Case 9
                   .TopLeftCell.Value = Sheet2.Range("F1").Offset(OptNo, 1)
                   Cells(Rw, 10).Value = Sheet2.Range("F1").Offset(OptNo, 2)
                Case 13
                   .TopLeftCell.Value = Sheet2.Range("K1").Offset(OptNo, 1)
                   Cells(Rw, 10).Value = Sheet2.Range("K1").Offset(OptNo, 2)
                Case 17
                   .TopLeftCell.Value = Sheet2.Range("A12").Offset(OptNo, 1)
                   Cells(Rw, 10).Value = Sheet2.Range("A12").Offset(OptNo, 2)
            End Select
            Sheet1.Range("G23").Value = "Score selected" 'clear score
        End If
    End With
Next n
End Sub

Note that I've added comments on the Ref sheet so that the Comments column on Mock-up to show the correct cells have been picked (you will need to replace those comments in Ref with real text).

This sub receives two variables from the button macros (one per button) which pass through the numeric part of the button name e.g. the 3 from the button called "Flowchart: Process 3" plus the row that buttion is on. Some parts change per button (see bits in bold from this extract):

Sub Crt1Opt1()

Call GreyOptions(3, 5)

End Sub

Sub Crt1Opt2()

Call GreyOptions(4, 5)

End Sub

Sub Crt1Opt3()

Call GreyOptions(5, 5)

End Sub

Sub Crt1Opt4()

Call GreyOptions(6, 5)

End Sub

Sub Crt1Opt5()

Call GreyOptions(7, 5)

End Sub

Sub Crt2Opt1()

Call GreyOptions(8, 9)

End Sub

etc.

Given the numbers are hidden behind the button and H21 holds the sum of those, the macro to evalauate the score (when then oval is clicked) is just

 
 Sub EvalScore()

Sheet1.Range("G23").Value = Sheet1.Range("H21").Value

End Sub

Under the score, I've added a green button to reset the sheet. The code for that is:

Sub Reset()



Dim Clrs As Variant



Clrs = Array(5606641, 13337440, 4638719, 6404225, 13395711)



For n = 3 To 22

    With Sheet1.Shapes("Flowchart: Process " & n) ' pick shape

        .Fill.Solid

        .Fill.ForeColor.RGB = Clrs((n - 3) Mod 5) 'set colour

        .TextFrame.Characters.Font.Color = vbWhite 'set font colour

        .TopLeftCell.Value = "" 'clear any value in cell behind

    End With

    Sheet1.Range("J5:J17").Value = "" 'clear comments

    Sheet1.Range("G23").Value = "Score selected" 'clear score

Next n




End Sub

REVISION:

In the second file attached below, a variable number of options per criteria can be used (without specifying the number in column A as Joe had). The file relies on the button macros instead passing the Option number (and the row which it's on) to the main macro, which now loops through the shapes on a row using this structure:

Sub GetShpsOnRw(Opt As Integer, Rw As Integer)

....

For Each Shp In Sheet1.Shapes
    With Shp
        If InStr(.Name, "Flowchart: Process ") <> 0 Then
            If .TopLeftCell.Row = Rw Then
                If .TopLeftCell.Column - 4 <> Opt Then

                '<actions for other options>

                Else:

                '<actions for chosen option>

                End If
            End If
        End If
    End With
Next Shp

End Sub
Each button macro now instead passes the option picked (where column E is Option 1, column F is 2 etc.) and the row it's on e.g.:
Sub Crt1Opt1()
Call GetShpsOnRw(1, 5)
End Sub
Look in the file for the details of each new macro.

Hope this works for you.

Discuss

Discussion

Thank you so very much John. You're really my Santa this Christmas. Just one more question that need your advice. What if the number of option is not equal between all criteria? I've adjusted following your code but it cannot run properly, could you please prefer my latest attachment & advise? Thank you
joevn93 (rep: 4) Dec 17, '21 at 4:18 am
Joe, wish you'd mentioned the varying options before. Feels like I answered your question fully then you moved the goal posts (for the answer to be Selected)!

Not sure I'll have time today to rework it
John_Ru (rep: 6102) Dec 17, '21 at 5:31 am
Joe, please see the REVISION to my Answer (and the second file)
John_Ru (rep: 6102) Dec 17, '21 at 7:10 pm
Thanks a lot John. Really appreciated. Wish you a merry Christmas and a happy new year ahead.
joevn93 (rep: 4) Dec 17, '21 at 11:43 pm
Thanks for selecting my Answer Joe. Have a great Xmas too. 
John_Ru (rep: 6102) Dec 18, '21 at 2:05 am
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login