Extracting data from a dynamic userform VBA

Question

All,

I have the below code which creates a dynamic userform based on a list located in an excel worksheet. (Please see picture below)

When the user selects submit I would like to extract all the answers from the user form into an excel file.

Does anyone know how I would do this as I have hit a brick wall in thoughts, the user form to my knowledge has to be built via vba as the list of Project ID & UR can vary from 1 line to thousands of lines.

Any help would be much appreciated.

Sub addLabel()
UserForm6.Show vbModeless
Dim theLabel As Object
Dim ComboBox1 As Object
Dim CommandApp As Object
Dim CommandCan As Object
Dim buttonheight As Long

Dim labelCounter As Long

For Each c In Sheets("Sheet1").Range("A1:A100")
If c.Value = "" Then Exit For
    Set theLabel = UserForm6.Controls.Add("Forms.label.1", "Test" & c, True)
    With theLabel
    .Caption = c
    .Left = 10
    .Width = 50
    .Height = 20
    .Font.Size = 10
    If c.Row = 1 Then
    .Top = 34
    Else
    .Top = 25 + (20 * (c.Row - 1)) + 9
    End If
    End With

  Set ComboBox1 = UserForm6.Controls.Add("Forms.combobox.1", "Test" & c, True)

 With ComboBox1
    .AddItem "Approved"
    .AddItem "Partially Approved"
    .AddItem "Not Approved"
    .Left = 190
    .Width = 120
    .Height = 20
    .Font.Size = 10
    If c.Row = 1 Then
    .Top = 30
    Else
    .Top = 30 + (20 * (c.Row - 1))
    buttonheight = 30 + (20 * (c.Row - 1))
    End If
End With
Next c

For Each c In Sheets("Sheet1").Range("B1:B100")
 If c.Value = "" Then Exit For
   Set theLabel = UserForm6.Controls.Add("Forms.label.1", "Test" & c, True)
    With theLabel
    .Caption = c
    .Left = 90
    .Width = 70
    .Height = 20
    .Font.Size = 10
     If c.Row = 1 Then
    .Top = 34
     Else
    .Top = 25 + (20 * (c.Row - 1)) + 9
     End If
    End With
Next c

With UserForm6
.Width = 340
.Height = buttonheight + 90

End With

Set CommandApp = UserForm6.Controls.Add("Forms.Commandbutton.1", "Test" & c, True)
With CommandApp
    .Caption = "Submit"
    .Left = 10
    .Width = 140
    .Font.Size = 10
    .Top = buttonheight + 30
End With

Set CommandCan = UserForm6.Controls.Add("Forms.Commandbutton.1", "Test" & c, True)
With CommandCan
    .Caption = "Cancel"
    .Left = 170
    .Width = 140
    .Font.Size = 10
    .Top = buttonheight + 30
End With

End Sub

Answer 1

You will need create variables to hold references to the newly created CommandButtons. By adding the WithEvents modifier you will be able to receive the CommandButton events.

Naming the controls after cell values is problematic. A better solution is to use the MSForms Control Tag property to hold your references. In my example below I add a qualified reference to the target cell.

• Changed the subroutines name from addLabel to something more meaningful Show_UserForm6.

• Combobox values as they are added.

Userform6 Module

Option Explicit
Public WithEvents CommandApp As MSForms.CommandButton
Public WithEvents CommandCan As MSForms.CommandButton

Private Sub CommandApp_Click()
    Dim ctrl As MSForms.Control

    For Each ctrl In Me.Controls
        If TypeName(ctrl) = "ComboBox" Then
            Range(ctrl.Tag).Value = ctrl.Value
        End If
    Next

End Sub

Private Sub CommandCan_Click()
    Unload Me
End Sub

Refactored Code

Sub Show_UserForm6()
    Const PaddingTop = 34, Left1 = 10, Left2 = 90, Left3 = 190
    Dim c As Range
    Dim Top As Single
    Top = 34
    With UserForm6
        .Show vbModeless
        For Each c In Sheets("Sheet1").Range("A1:A100")
            If c.Value = "" Then Exit For

            With getNewControl(.Controls, "Forms.Label.1", Left1, 50, 20, Top)
                .Caption = c.Value
                .Tag = "'" & c.Parent.Name & "'!" & c.Address
            End With

            With getNewControl(.Controls, "Forms.Label.1", Left2, 50, 20, Top)
                .Caption = c.Offset(0, 1).Value
                .Tag = "'" & c.Parent.Name & "'!" & c.Offset(0, 2).Address
            End With

            With getNewControl(.Controls, "Forms.ComboBox.1", Left3, 120, 20, Top)
                .List = Array("Approved", "Partially Approved", "Not Approved")
                .Tag = "'" & c.Parent.Name & "'!" & c.Offset(0, 2).Address
                .Value = c.Offset(0, 2).Value
            End With

            Top = Top + 20
        Next

        Set .CommandApp = getNewControl(.Controls, "Forms.Commandbutton.1", 10, 140, 20, Top + 10)

        With .CommandApp
            .Caption = "Submit"
        End With

        Set .CommandCan = getNewControl(.Controls, "Forms.Commandbutton.1", 170, 140, 20, Top + 10)

        With .CommandCan
            .Caption = "Cancel"
        End With
    End With
End Sub

Function getNewControl(Controls As MSForms.Controls, ProgID As String, Left As Single, Width As Single, Height As Single, Top As Single) As MSForms.Control
    Dim ctrl As MSForms.Control
    Set ctrl = Controls.Add(ProgID)
    With ctrl
        .Left = Left
        .Width = Width
        .Font.Size = 10
        .Top = Top
    End With
    Set getNewControl = ctrl
End Function

Answer 2

Generally I'd set up classes and collections to hold references to your new controls.

It can work with your current set up though. First off I'll suggest an aesthetic change:

• Set the size of your frame to a static size that fits on your screen and add the two command buttons outside of this.
• Size the frame so it sits inside the bounds of your form.
• Change the ScrollBars property to 2 - fmScrollBarsVertical.

In your code:
Add a new variable

Dim fme As Frame  
Set fme = UserForm6.Frame1

Update your references to UserForm6 so they reference fme instead when you add the labels and combobox:

Set theLabel = fme.Add("Forms.label.1", "Test" & c, True)  
.
.
Set ComboBox1 = fme.Controls.Add("Forms.combobox.1", "Test" & c, True) 
.
.
Set theLabel = fme.Controls.Add("Forms.label.1", "Test" & c, True)

Outside your final loop add this line of code (you may have to play around with the maths to get the correct scroll height):

fme.ScrollHeight = buttonheight + 90  

Remove the code that adds the two command buttons (as they're now static outside of the frame).

Now your whole form should sit on the page and you can scroll through the controls.

Double-click your command button to add a Click event to it:

Private Sub CommandButton1_Click()
    Dim ctrl As Control
    Dim x As Long

    For Each ctrl In Me.Frame1.Controls
        If TypeName(ctrl) = "ComboBox" Then
            x = x + 1
            ThisWorkbook.Worksheets("Sheet2").Cells(x, 1) = ctrl.Value
        End If
    Next ctrl
End Sub

The code will go through each combobox on the form and copy the selected value to Sheet2 in the workbook.

---

Edit:

All the code incorporating the changes I made.

Sub addLabel()
    UserForm6.Show vbModeless
    Dim theLabel As Object
    Dim ComboBox1 As Object
    Dim CommandApp As Object
    Dim CommandCan As Object
    Dim buttonheight As Long

    Dim fme As Frame

    Dim c As Variant

    Dim labelCounter As Long

    Set fme = UserForm6.Frame1

    For Each c In Sheets("Sheet1").Range("A1:A100")
    If c.Value = "" Then Exit For
        Set theLabel = fme.Add("Forms.label.1", "Test" & c, True)
        With theLabel
        .Caption = c
        .Left = 10
        .Width = 50
        .Height = 20
        .Font.Size = 10
        If c.Row = 1 Then
        .Top = 34
        Else
        .Top = 25 + (20 * (c.Row - 1)) + 9
        End If
        End With

      Set ComboBox1 = fme.Controls.Add("Forms.combobox.1", "Test" & c, True)

     With ComboBox1
        .AddItem "Approved"
        .AddItem "Partially Approved"
        .AddItem "Not Approved"
        .Left = 190
        .Width = 120
        .Height = 20
        .Font.Size = 10
        If c.Row = 1 Then
        .Top = 30
        Else
        .Top = 30 + (20 * (c.Row - 1))
        buttonheight = 30 + (20 * (c.Row - 1))
        End If
    End With
    Next c

    For Each c In Sheets("Sheet1").Range("B1:B100")
     If c.Value = "" Then Exit For
       Set theLabel = fme.Controls.Add("Forms.label.1", "Test" & c, True)
        With theLabel
        .Caption = c
        .Left = 90
        .Width = 70
        .Height = 20
        .Font.Size = 10
         If c.Row = 1 Then
        .Top = 34
         Else
        .Top = 25 + (20 * (c.Row - 1)) + 9
         End If
        End With
    Next c

    fme.ScrollHeight = buttonheight + 90

End Sub