Excel 2013 VBA: Temporary userform copy all checkbox selections to range

[jedwardo]

Hi everybody,

I modified a TempForm i found and replaced the optionsbuttons with checkboxes to implement in my project. I'm now trying to get the values of all selected checkboxes onto my worksheet but as it is it simply overwrites all selections into the same cell with the bottom most selection as the final result. Here's the GetOption module below. I also tried creating a listbox on the userform as well in place of the checkboxes but couldn't figure out how to populate the list with my dynamic range so I'm back to the checkboxes as they are kind of working.

Option Explicit

'Passed back to the function from the UserForm
Public GETOPTION_RET_VAL As Variant

Function GetOption(OpArray, Default, Title)
    Dim TempForm  'As VBComponent
    Dim NewCheckBox As MSForms.CheckBox
    Dim NewCommandButton1 As MSForms.CommandButton
    Dim NewCommandButton2 As MSForms.CommandButton
    Dim TextLocation As Integer
    Dim X As Integer, i As Integer, TopPos As Integer
    Dim MaxWidth As Long
    Dim WasVisible As Boolean
    
    Dim NewListBox1 As MSForms.ListBox
    
'   Hide VBE window to prevent screen flashing
    Application.VBE.MainWindow.Visible = False

'   Create the UserForm
    Set TempForm = ThisWorkbook.VBProject.VBComponents.Add(3)
    TempForm.Properties("Width") = 800
    
'   Add the CheckBoxes
    TopPos = 4
    MaxWidth = 0 'Stores width of widest OptionButton
    For i = LBound(OpArray) To UBound(OpArray)
        Set NewCheckBox = TempForm.Designer.Controls.Add("forms.CheckBox.1")
        With NewCheckBox
            .Width = 800
            .Caption = OpArray(i)
            .Height = 15
            .Left = 8
            .Top = TopPos
            .Tag = i
            .AutoSize = True
            If Default = i Then .Value = False
            If .Width > MaxWidth Then MaxWidth = .Width
        End With
        TopPos = TopPos + 15
    Next i
    
''''''''''''''''''''''''''''''''''''''''  '''''''''''''''''''''''''''
'
''   Add the ListBox
'    Set NewListBox1 = TempForm.Designer.Controls.Add("forms.ListBox.1")
'    With NewListBox1
'        .ListStyle = fmListStyleOption
'        .MultiSelect = fmMultiSelectMulti
'        .Height = 100
'        .Width = 60
'        .Left = MaxWidth + 12
'        .Top = 6
'    End With
'
'''''''''''''''''''''''''''''''''''''''''  '''''''''''''''''''''''''''''''''
    
    
'   Add the Cancel button
    Set NewCommandButton1 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
    With NewCommandButton1
        .Caption = "Cancel"
        .Height = 18
        .Width = 44
        .Left = MaxWidth + 12
        .Top = 6
    End With

'   Add the OK button
    Set NewCommandButton2 = TempForm.Designer.Controls.Add("forms.CommandButton.1")
    With NewCommandButton2
        .Caption = "OK"
        .Height = 18
        .Width = 44
        .Left = MaxWidth + 12
        .Top = 28
    End With

'   Add event-hander subs for the CommandButtons
    With TempForm.CodeModule
        X = .CountOfLines
        .InsertLines X + 1, "Sub CommandButton1_Click()"
        .InsertLines X + 2, "  GETOPTION_RET_VAL=False"
        .InsertLines X + 3, "  Unload Me"
        .InsertLines X + 4, "End Sub"
        
        .InsertLines X + 5, "Sub CommandButton2_Click()"
        .InsertLines X + 6, "  Dim ctl"
        .InsertLines X + 7, "  GETOPTION_RET_VAL = False"
        .InsertLines X + 8, "  For Each ctl In Me.Controls"
        .InsertLines X + 9, "    If ctl.Tag <> """" Then If ctl Then GETOPTION_RET_VAL = ctl.Tag"
        .InsertLines X + 10, "  Next ctl"
        .InsertLines X + 11, "  Unload Me"
        .InsertLines X + 12, "End Sub"
    End With
    
'   Adjust the form
    With TempForm
        .Properties("Caption") = Title
        .Properties("Width") = NewCommandButton1.Left + NewCommandButton1.Width + 10
        If .Properties("Width") < 160 Then
            .Properties("Width") = 160
            NewCommandButton1.Left = 106
            NewCommandButton2.Left = 106
        End If
        .Properties("Height") = TopPos + 54
    End With

'   Show the form
    VBA.UserForms.Add(TempForm.Name).Show

'   Delete the form
    ThisWorkbook.VBProject.VBComponents.Remove VBComponent:=TempForm
    
'   Pass the selected option back to the calling procedure
    GetOption = GETOPTION_RET_VAL
End Function

And here is the command button to display the tempforms:

Private Sub CommandButtonTemps_Click()

    Dim cCell As Range, vRng As Range, sRng As Range 'counter cell, vertical (transposed) range, selected range
    Dim Ops() As Variant
    Dim Cnt As Integer, i As Integer
    Dim UserChoice As Variant

    
   [COLOR=#0000cd] For Each cCell In Range("a125:z125")
        With cCell
            If .Value <> "" Then
                Set vRng = Range(.Offset(1, 0).Address & ":" & Range(.Address).End(xlDown).Address)           'dynamic range source for checkboxes[/COLOR]
                    
                    Cnt = vRng.Count
                    ReDim Ops(1 To Cnt)
                    For i = 1 To Cnt
                        Ops(i) = vRng.Range("A1").Offset(i - 1, 0)
                    Next i
                    
                    UserChoice = GetOption(Ops, 1, .Value)          'TempForm Caption = cCell.value
                    If UserChoice = False Then
                        Range("a52") = ""
                    Else
                      [COLOR=#ff0000]  If Cells(52, cCell.Column).Value <> "" Then                                                                         'next empty row for result
                            Set sRng = Range(.Offset(-73, 0).Address & ":" & Range(.Address).End(xlUp).Address)             '' ''
                            sRng.Offset(1, 0) = Ops(UserChoice)                                                                               '' ''[/COLOR]
                        Else                                                                                                                               '' ''
                            Cells(52, cCell.Column).Value = Ops(UserChoice)                                                                '' ''
                        End If
                    End If
  
            End If
        End With
    Next cCell
    
End Sub

The blue text is what I added to create the dynamic ranges for each sequential TempForm

The red was my attempt at copying the selections to my sheet

First pic below is temp form. Second is after making selections from each tempform. Even when making multiple selections only one is transfered to sheet.
Third pic is if I run he forms again, it places the next selection in the cell below like it's supposed to but won't paste multiple selections in the same manner all in one go.

Thanks for taking a look.

Regards,
Jordan

 

[jedwardo]

Nevermind just saw a post from yesterday bump up that's exactly the same with the answer I need.

http://www.mrexcel.com/forum/excel-questions/826754-temp-form-option-buttons-multiple-selection.html