Loop through all form control option buttons in their various groupboxes

[Wingersiow]

Hi,

As a complete newbie I really seem to be struggling with this problem and am hoping that someone has a nice easy answer.

I have a sheet which is essentially being used as a questionnaire. On the sheet are a number of group boxes which each contain up to a maximum of 8 option buttons (all form control) I need to ensure that each group box has an option button selected before it is submitted. I would therefore like to loop through each group box in turn to check that one of the option buttons has been selected before moving on to the next Group Box. However I only seem to be able to loop through each option button on the sheet. The MsgBoxes are there just to help me with some basic testing. Any ideas would be really appreciated. My code is:

Sub Button63_Click()

Dim OB As OptionButton
Dim Group As GroupBox

For Each Group In ActiveSheet.GroupBoxes
For Each OB In ActiveSheet.OptionButtons 'I guess that the problem is here as I need
'to look at each option button in the Group rather that the sheet

MsgBox "MSG 1 Group " & Group.Name & " OB Name " & OB.Name
If OB.Value = 1 Then
OB.Select
With Selection.Interior
.Pattern = xlSolid
.Color = 255
End With
MsgBox "Msg 2 " & Group.Name & " " & OB.Name & _
vbNewLine & _
"Alt text: " & OB.ShapeRange.AlternativeText
End If
Next
Next

End Sub

Thanks
Wingersiow

 

[Wingersiow]

Sorry, I can't find a way to edit my post but wanted to make to code more readable so here is the code again.

Sub Button63_Click()

Dim OB As OptionButton
Dim Group As GroupBox

For Each Group In ActiveSheet.GroupBoxes
    For Each OB In ActiveSheet.OptionButtons 'I guess that the problem is here as I need
                                             'to look at each option button in the Group rather that the sheet
            
        MsgBox "MSG 1 Group " & Group.Name & " OB Name " & OB.Name
        If OB.Value = 1 Then
            OB.Select
            With Selection.Interior
                .Pattern = xlSolid
                .Color = 255
             End With
            MsgBox "Msg 2 " & Group.Name & " " & OB.Name & _
                    vbNewLine & _
                    "Alt text: " & OB.ShapeRange.AlternativeText
        End If
    Next
Next

End Sub

 

[Wingersiow]

Solved - Loop through all form control option buttons in their various groupboxes

Solved - Hurrah!

Hi,

Thanks to anyone who may have given this a little bit of thought - but I have now come up with a solution. The attached code essentially loops through all Option Buttons within a group box to ensure that one option button has been selected - if not it highlights the linked cell (behind the Group box) in Red. It then moves through the rest of group boxes on the sheet doing essentially the same thing before putting out a final error message. Hopefully someone else may find this useful - probably for questionnaires.

Thanks
Wingersiow

Sub Button63_Click()

'Notes
'Radio buttons must fall within a group
'Radio Buttons must be linked to a cell

Dim OB As OptionButton
Dim Group As GroupBox
Dim Highlight As Integer
Dim HighlightCell As String
Dim Count As Integer
Dim Answer As String
Dim SetCell As String

Count = 0
SetCell = ""

For Each Group In ActiveSheet.GroupBoxes
Highlight = 1 'this is used to highlight the cells in error
    For Each OB In ActiveSheet.OptionButtons
        If Group.Name <> OB.GroupBox.Name Then 'this identifies a change of group boxes
            GoTo JumpOut
        End If
            If OB.Value = 1 Then
                Highlight = 0
            Else
                HighlightCell = OB.LinkedCell
            End If
JumpOut: Next
    If Highlight = 1 Then
        ActiveSheet.Range(HighlightCell).Select
        With Selection.Interior
            .Pattern = xlSolid
            .Color = 255
        End With
        With Selection.Font
            .Color = -16776961
            .TintAndShade = 0
        End With
        Count = Count + 1
        If Count = 1 Then
            SetCell = HighlightCell
        End If
    Else
        ActiveSheet.Range(HighlightCell).Select
        With Selection.Interior
            .Pattern = xlNone
        End With
        With Selection.Font
            .ThemeColor = xlThemeColorDark1
            .TintAndShade = 0
        End With
    End If
    Highlight = 1
    
Next
'Put out a message of the cells in error and select the first instance
If Count > 0 Then
    Answer = MsgBox("Please enter values for the missing " & Count & " questions which have been highlighted in red", vbOK, "Missing Answers")
    ActiveSheet.Range(SetCell).Select
End If

End Sub