VBA - Loop Option Buttons & Check Boxes on a UserForm

Question

I am trying to display specific data in a specific worksheet using a user form.

There is one command button on the user form - Next - that takes the users preferences (option button chosen), opens a new workbook, and displays the desired data (check boxes chosen) in the specific workbook.

There are 6 option buttons and and 6 check boxes. The worksheet that opens is based on the option button preference and depending on what was chosen in the check boxes, the data associated to that topic will display in the worksheet.

How can i loop options buttons and check boxes on a userform and capture which are "selected"?

The data displayed (in a worksheet) from the chosen check boxes depends on the option button chosen e.g. if I chose Finance (option button), and then I chose Photos and Videos (check boxes), I'd like to display data specific to those selections on the appropriate worksheet.

Here is what I have so far:

Private Sub cmdNext_Click()
'declare variables
Dim strFinancial As String, strFamily As String, strSadness As String, 
strSchool As String, strRelationship As String, strTime As String
Dim shtFinancial As Worksheet, shtFamily As Worksheet, shtSadness As 
Worksheet, shtSchool As Worksheet, shtRelationship As Worksheet, 
shtTime As Worksheet, shtData As Worksheet

shtFinancial = Workbooks("PROJECT.xlsm").Worksheets("Financial")
shtTime = Workbooks("PROJECT.xlsm").Worksheets("Time")
shtFamily = Workbooks("PROJECT.xlsm").Worksheets("Family")
shtSadness = Workbooks("PROJECT.xlsm").Worksheets("Sadness")
shtSchool = Workbooks("PROJECT.xlsm").Worksheets("School")
shtRelationship = Workbooks("PROJECT.xlsm").Worksheets("Relationship")
shtData = Workbooks("PROJECT.xlsm").Worksheets("Data")


'set option button selection to string
strFinancial = obFinancial.Value
strFamily = obFamily.Value
strSadness = obSadness.Value
strSchool = obSchool.Value
strRelationship = obRelationship.Value
strTime = obTime.Value


'activate worksheet of chosen stressor (option button)
Select Case True

Case strTime = True
shtTime.activate

Case strFinancial = True
shtFinancial.activate

Case strFamily = True
shtFamily.activate

Case strSadness = True
shtSadness.activate

Case strSchool = True
shtSchool.activate

Case strRelationship = True
shtRelationship.activate

End Select


'ADVICE

'loop through checkboxes HOW ????

'display advice according to option button chosen

If obFinancial.Value = True And Me.cbAdvice.Value = True Then
shtData.Range("A1:A10").Copy Destination:=Sheets("Financial").Range("A1:A10")
End If

If obSadness.Value = True And Me.cbAdvice.Value = True Then
Sheets("Data").Range("A21:A30").Copy Destination:=Sheets("Sadness").Range("A1:A10")
End If

If obSchool.Value = True And Me.cbAdvice.Value = True Then
Sheets("Data").Range("A31:A40").Copy Destination:=Sheets("School").Range("A1:A10")
End If

If obRelationship.Value = True And Me.cbAdvice.Value = True Then
Sheets("Data").Range("A41:A50").Copy Destination:=Sheets("Relationship").Range("A1:A10")
End If

If obTime.Value = True And Me.cbAdvice.Value = True Then
Sheets("Data").Range("A51:A60").Copy Destination:=Sheets("Time").Range("A1:A10")
End If
End Sub

Here is the userform:

Answer 1

Yes, it's little bit unclear what you trying to do... Following is a general example how you might loop through CheckBoxes and OptionButtons:

Private Sub CommandButton1_Click()

    Dim c As Control, str As String

    For Each c In UserForm1.Controls
        If TypeName(c) = "CheckBox" Or TypeName(c) = "OptionButton" Then
            str = str & IIf(c = True, c.Caption & vbCrLf, "")
        End If
    Next c

    MsgBox "Selected controls" & vbCrLf & str

End Sub

Answer 2

It is a little difficult to see exactly what you want but I can't help wondering if you're looking at VBA in the wrong way. VBA is an event-driven language, meaning that you can capture most interactions the user has with your programme. This should do away with the need to loop through your controls each time, as you could just log selections as the user makes them.

The most obvious thing to do would be to create some kind of sheet/range map, say in a Collection, and then just retrieve the objects you want based on a selection key. The code below is a skeleton of how you could do it - obviously you'd need to expand and adjust it to suit your own needs.

First declare a few variables at module-level (ie very top of your page):

Option Explicit

Private mRangeMap As Collection
Private mOptKey As String
Private mCboxKey As String

Then build your map. In the example below, I've done this in the Userform_Initialize routine, but you could call it anywhere:

Private Sub UserForm_Initialize()
    Dim shtRngPair(1) As Object

    'Build the range map.
    Set mRangeMap = New Collection
    With ThisWorkbook 'use name ofyour workbook
        Set shtRngPair(0) = .Worksheets("Financial")
        With .Worksheets("Data")
            Set shtRngPair(1) = .Range("A1:A10")
            mRangeMap.Add shtRngPair, "Fin|Adv"

            Set shtRngPair(1) = .Range("A11:A20")
            mRangeMap.Add shtRngPair, "Fin|Pho"
        End With

        Set shtRngPair(0) = .Worksheets("Sadness")
        With .Worksheets("Data")
            Set shtRngPair(1) = .Range("A21:A30")
            mRangeMap.Add shtRngPair, "Sad|Adv"

            Set shtRngPair(1) = .Range("A31:A40")
            mRangeMap.Add shtRngPair, "Sad|Pho"
        End With

        Set shtRngPair(0) = .Worksheets("School")
        With .Worksheets("Data")
            Set shtRngPair(1) = .Range("A41:A50")
            mRangeMap.Add shtRngPair, "Sch|Adv"

            Set shtRngPair(1) = .Range("A51:A60")
            mRangeMap.Add shtRngPair, "Sch|Pho"
        End With
    End With

End Sub

Now you just need the code to store the user inputs. I just have 3 option buttons and 2 checkboxes for an example:

Private Sub cboxAdvice_Click()
    mCboxKey = "Adv"
End Sub

Private Sub cboxPhotos_Click()
    mCboxKey = "Pho"
End Sub

Private Sub obFinancial_Click()
    mOptKey = "Fin"
End Sub

Private Sub obSadness_Click()
    mOptKey = "Sad"
End Sub

Private Sub obSchool_Click()
    mOptKey = "Sch"
End Sub

Finally, copy the data when the user hits the Next button:

Private Sub cmdNext_Click()
    Dim key As String
    Dim shtRngPair As Variant
    Dim v As Variant

    'Create the key
    key = mOptKey & "|" & mCboxKey

    'Find the relevant range
    On Error Resume Next
    shtRngPair = mRangeMap(key)
    On Error GoTo 0

    'Test if the key is valid
    If IsEmpty(shtRngPair) Then
        MsgBox "Selection [" & key & "] is invalid."
        Exit Sub
    End If

    'Copy the data
    v = shtRngPair(1).Value2
    With shtRngPair(0)
        .Cells.Clear
        .Range("A1").Resize(UBound(v, 1), UBound(v, 2)).Value = v
        .Activate
    End With
End Sub

Update as per OP's comment

Below is the updated code which iterates your checkbox selections. You'd need to add additional code if you wanted them in a specific order:

Option Explicit

Private mRangeMap As Collection
Private mCboxKeys As Collection
Private mOptKey As String

Private Sub cboxAdvice_Change()
    UpdateCheckboxList "Adv", cboxAdvice.Value
End Sub

Private Sub cboxPhotos_Change()
    UpdateCheckboxList "Pho", cboxPhotos.Value
End Sub
Private Sub UpdateCheckboxList(ele As String, addItem As Boolean)

    'Add or remove the item
    If addItem Then
        mCboxKeys.Add ele, ele
    Else
        mCboxKeys.Remove ele
    End If

End Sub
Private Sub obFinancial_Click()
    mOptKey = "Fin"
End Sub

Private Sub obSadness_Click()
    mOptKey = "Sad"
End Sub

Private Sub obSchool_Click()
    mOptKey = "Sch"
End Sub

Private Sub cmdNext_Click()
    Dim key As String
    Dim shtRngPair As Variant, v As Variant, cbk As Variant
    Dim rng As Range
    Dim initialised As Boolean

    For Each cbk In mCboxKeys
        'Create the key
        key = mOptKey & "|" & cbk

        'Find the relevant range
        On Error Resume Next
        shtRngPair = mRangeMap(key)
        On Error GoTo 0

        If IsEmpty(shtRngPair) Then
            'Test if the key is valid
            MsgBox "Selection [" & key & "] is invalid."
        Else
            If Not initialised Then
                With shtRngPair(0)
                    .Cells.Clear
                    .Activate
                    Set rng = .Range("A1")
                End With
                initialised = True
            End If
            'Copy the data
            v = shtRngPair(1).Value2
            rng.Resize(UBound(v, 1), UBound(v, 2)).Value = v
            'Offset range
            Set rng = rng.Offset(UBound(v, 1))
        End If
    Next
End Sub

Private Sub UserForm_Initialize()
    Dim shtRngPair(1) As Object

    'Initialise the collections
    Set mRangeMap = New Collection
    Set mCboxKeys = New Collection

    'Build the range map.
    With ThisWorkbook 'use name ofyour workbook
        Set shtRngPair(0) = .Worksheets("Financial")
        With .Worksheets("Data")
            Set shtRngPair(1) = .Range("A1:A10")
            mRangeMap.Add shtRngPair, "Fin|Adv"

            Set shtRngPair(1) = .Range("A11:A20")
            mRangeMap.Add shtRngPair, "Fin|Pho"
        End With

        Set shtRngPair(0) = .Worksheets("Sadness")
        With .Worksheets("Data")
            Set shtRngPair(1) = .Range("A21:A30")
            mRangeMap.Add shtRngPair, "Sad|Adv"

            Set shtRngPair(1) = .Range("A31:A40")
            mRangeMap.Add shtRngPair, "Sad|Pho"
        End With

        Set shtRngPair(0) = .Worksheets("School")
        With .Worksheets("Data")
            Set shtRngPair(1) = .Range("A41:A50")
            mRangeMap.Add shtRngPair, "Sch|Adv"

            Set shtRngPair(1) = .Range("A51:A60")
            mRangeMap.Add shtRngPair, "Sch|Pho"
        End With
    End With

End Sub