VBA - Loop Option Buttons & Check Boxes on a UserForm - vba

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