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.