Option button linked cells

Hi Gethsaine,

See the attached file which creates groups of Active X OptionButtons. The file does not use 'Linked Cells' but the following syntax in the Create Section should do the job for you. This particular file uses a class event handler.

TempControl.LinkedCell = "A39"

In your situation, I would name the OptionButtons and Groups in some kind of sequence (e.g. 'OptionButton00103 (3rd option button in first group) and 'Group001'. That way each item has a unique name. If you are inserting new rows, you would have to access all the OptionButtons on the Sheet to determine what the next sequential group number would be.

Lewis

---------------------------
Ordinary Module Code:

Option Explicit

'This code is based on code from Andy Pope (Thank you Andy)
'http://www.excelforum.com/excel-programming-vba-macros/1021112-call-userform-from-a-variable-number-of-activex-command-buttons.html

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'The following line ENABLES or DISABLES 'MsgBox' output
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Const bEnableMSGBOX As Boolean = True


Private Const myOptionButtonCOUNT As Long = 6
Private Const sControlTypeDESCRIPTION As String = "Active X OptionButton"
Private Const sControlTYPE As String = "OptionButton"
Public myOptionButtonEvents As Collection

Sub DisableEventsThenPopulateThenEnableEventsForOptionButtons()
  'NOTE: All the routines seem to work fine independently.
  '      Some routines do not play well with others, when cascaded together.
  '      That is why the 'Delete' and 'Create' routines are not in this routine.

  Call DisableOptionButtonEvents
  Call PopulateOptionButtons
  Call EnableOptionButtonEvents

End Sub


Sub CreateOptionButtons()
  'This Creates 'Active X' Controls

  Dim Output As Range
  Dim TempControl As OLEObject
  
  Dim iCount As Long
  Dim iControlsInGroup As Long
  Dim iIndex As Long
  
  Dim sGroupName As String
  Dim sCaption As String
    
  'First Control will be at the 'Top Left' of the following cell
  Set Output = ActiveSheet.Range("B4")
  
  'Create two groups of option Button
  iControlsInGroup = myOptionButtonCOUNT / 2
  
  For iIndex = 1 To myOptionButtonCOUNT
  
    'Create the Command Button
    Set TempControl = ActiveSheet.OLEObjects.Add(ClassType:="Forms.OptionButton.1", _
                                              Link:=False, _
                                              DisplayAsIcon:=False, _
                                              Left:=Output.Left, _
                                              Top:=Output.Top, _
                                              Width:=Output.Width * 2, _
                                              Height:=Output.Height * 2)
                                              
    
    If iIndex <= iControlsInGroup Then
      sCaption = "Group" & "A " & iIndex
      sGroupName = "GroupA"
    Else
      sCaption = "Group" & "B " & (iIndex - iControlsInGroup)
      sGroupName = "GroupB"
    End If
    TempControl.Object.Caption = sCaption
    TempControl.Object.GroupName = sGroupName
    
    Debug.Print "'''''''''''''''''''''''''''"
    Debug.Print TempControl.Top
    Debug.Print TempControl.Name
    Debug.Print TempControl.Object.Caption
    Debug.Print TempControl.Object.GroupName
                                              
    'Increment the 'Top Left' for the next OptionButton
    Set Output = Output.Offset(3, 0)
    
    'Increment the Control Created Count
    iCount = iCount + 1
  Next
  
  If bEnableMSGBOX = True Then
    MsgBox iCount & Format(sControlTypeDESCRIPTION, " @") & " Control(s) were Created."
  End If
  
  'Clear object pointer
  Set TempControl = Nothing

End Sub

Sub IterateThruOptionButtons()
  'This iterates through 'Active X' Controls in Immediate Window (CTRL G)

  Dim myObject As OLEObject
  Dim iCount As Long

  For Each myObject In ActiveSheet.OLEObjects
    If TypeName(myObject.Object) = "OptionButton" Then
       iCount = iCount + 1
       
       Debug.Print Format(iCount, "000  ") & _
                   Format(myObject.Name, "!@@@@@@@@@@@@@@@@@@  ") & _
                   Format(myObject.Object.Caption, "!@@@@@@@@@@@@  ") & _
                   Format(myObject.Object.GroupName, "!@@@@@@@  ") & _
                   Format(myObject.Object.Value, "!@@@@@@@  ") & _
                   Format(myObject.Top, "@@@@@@@  ") & _
                   Format(myObject.Left, "@@@@@@@  ") & _
                   Format(myObject.Width, "@@@@@@@  ") & _
                   Format(myObject.Height, "@@@@@@@  ")

    End If
  Next myObject
  
  If iCount = 0 Then
    Debug.Print "There were NO" & Format(sControlTypeDESCRIPTION, " @") & " CONTROLS to Iterate through."
  End If


End Sub


Sub EnableOptionButtonEvents()
  'This Enables Active X Events (Active X controls must already exist)

  Dim OptnButtonEvents As ClassOptionButtonEvent
  Dim myObject As OLEObject
  
  Dim iCount As Long
  Dim iIndex As Long
    
  'Define the Event Collection
  Set myOptionButtonEvents = New Collection
    
  'Create the Events
  For Each myObject In ActiveSheet.OLEObjects
    
    iIndex = iIndex + 1
  
    If TypeName(myObject.Object) = sControlTYPE Then
      Set OptnButtonEvents = New ClassOptionButtonEvent
      Set OptnButtonEvents.myOptionButton = ActiveSheet.OLEObjects(iIndex).Object
      myOptionButtonEvents.Add OptnButtonEvents, CStr(myOptionButtonEvents.Count + 1)
      iCount = iCount + 1
      If iCount >= myOptionButtonCOUNT Then
        Exit For
      End If
    End If
      
  Next myObject
  
  If bEnableMSGBOX = True Then
    MsgBox iCount & Format(sControlTypeDESCRIPTION, " @") & " Control Event(s) were Enabled."
  End If
  
End Sub

Sub DisableOptionButtonEvents()
  'This Disables Active X Events
  
  Dim iCount As Long
  Dim iStartingControlEventCount As Long
  
  'Test to see if Controls Exist
  On Error Resume Next
  iStartingControlEventCount = myOptionButtonEvents.Count
  On Error GoTo 0

  'Disable Controls
  If iStartingControlEventCount > 0 Then
    Do While myOptionButtonEvents.Count > 0
      myOptionButtonEvents.Remove 1
      iCount = iCount + 1
    Loop
  End If
  
  If bEnableMSGBOX = True Then
    MsgBox iCount & Format(sControlTypeDESCRIPTION, " @") & " Control Event(s) were Disabled."
  End If
  
  'Clear object pointer
  Set myOptionButtonEvents = Nothing
    
End Sub

Sub DeleteOptionButtons()
  'This deletes 'Active X' Controls

  Dim myObject As OLEObject
  Dim iCount As Long

  For Each myObject In ActiveSheet.OLEObjects
    If TypeName(myObject.Object) = sControlTYPE Then
       iCount = iCount + 1
       myObject.Delete
    End If
  Next myObject

  If bEnableMSGBOX = True Then
    MsgBox iCount & Format(sControlTypeDESCRIPTION, " @") & " Control(s) were Deleted."
  End If
  
End Sub

Class Module Code (Must be in Class Module Named 'ClassOptionButtonEvent'):

Option Explicit

'This code is based on code from Andy Pope (Thank you Andy)
'http://www.excelforum.com/excel-programming-vba-macros/1021112-call-userform-from-a-variable-number-of-activex-command-buttons.html

Public WithEvents myOptionButton As MSForms.OptionButton

Private Sub myOptionButton_Click()
  'This is the Active X Event Handler
  
  MsgBox "Clicked " & Me.myOptionButton.Name & " - " & Me.myOptionButton.Caption & " - " & Me.myOptionButton.Value
End Sub