CODEWITHSUNDEEP
excelvba
Theodore Lee
Theodore Lee

Reputation: 77

Excel VBA - dynamically adding radio buttons

Am currently using this code to insert radio buttons for a checklist I have in excel, but it doesn't seem to be linking my option buttons to the cell properly. Could anyone advise on what I'm doing wrong?

Thank you!

For x = 1 to 10

With ActiveSheet
  .Range("A" & x).select

  With .OptionButtons.Add(Selection.Left, Selection.Top, Selection.Width, 
    Selection.Height)
    .Name = "OptionButton & x
    .Caption = "Yes"
  End With

  .Shapes ("OptionButton" & x).ControlFormat.LinkedCell = "Sheet1!$B$" & x
End With

Next x

The radio button all end up being linked to "Sheet1!$B$10" instead of "Sheet1!$B$1" & x. I've checked and they don't appear to be grouped together.

Upvotes: 0

Views: 2579

Answers (1)

FaneDuru
FaneDuru

Reputation: 42256

It is not possible to do what you try. Option button is created to share the same result of the group. It is not possible in the way you try...

If you really need that, even if it looks strange to me, you can use the next workaround:

Adapt your code in this way:

Sub testInsertOptBut()
 Dim sh As Worksheet, rng As Range, x As Long
 Set sh = ActiveSheet 'use here your necessary sheet
 For x = 1 To 10
      Set rng = sh.Range("A" & x)
      With sh.OptionButtons.aDD(rng.left, rng.top, rng.width, rng.height)
        .Name = "OptionButton" & x
        .Caption = "Yes"
        .OnAction = "SetLinkedCell"
      End With
Next x
End Sub

And also create the next Sub able to do the required pseudo link:

Sub SetLinkedCell()
    ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(, 1) = _
            CBool(ActiveSheet.Shapes(Application.Caller).ControlFormat.Value)
End Sub

But a form OptionButton does not have events to trigger its false value. So, in order to make some sense, the above code should be adapted to adapt the value of all the other OptionButtons and the above Sub would be good to be adapted in this way:

Sub SetLinkedCell()
    Dim optB As OptionButton
    ActiveSheet.Shapes(Application.Caller).TopLeftCell.Offset(, 1) = _
            CBool(ActiveSheet.Shapes(Application.Caller).ControlFormat.Value)
    Set optB = ActiveSheet.OptionButtons(Application.Caller)
    refreshOptButt optB
End Sub

And also create a function to change the other OptionButtons value in the pseudo linked cells:

Function refreshOptButt(optBut As OptionButton)
  Dim sh As Worksheet, o As OptionButton
  Set sh = ActiveSheet
   For Each o In sh.OptionButtons
     If o.Name <> optBut.Name Then
        o.TopLeftCell.Offset(, 1).Value = False
     End If
   Next
End Function

But you maybe need check boxes instead of option buttons... Each of them can be linked to a cell:

Sub testInsertChkBoxes()
  Dim sh As Worksheet, rng As Range, x As Long
  Set sh = ActiveSheet 'use here your necessary sheet
  deleteChkBoxes
  For x = 1 To 10
      Set rng = sh.Range("A" & x)
      With sh.CheckBoxes.aDD(rng.left, rng.top, rng.width, rng.height)
        .Name = "chkBox" & x
        .Caption = "Yes"
        .LinkedCell = sh.Name & "!$B$" & x
      End With
 Next x
End Sub
Sub deleteChkBoxes()
   Dim sh As Shape
   For Each sh In ActiveSheet.Shapes
     If left(sh.Name, 6) = "chkBox" Then sh.Delete
    Next
End Sub

I also created a Sub to delete all existing (with a specific name root), to be used at least during tesing...

Upvotes: 2

Related Questions