Loop through userform textboxes named with different suffixes

Question

I need to extract data from a VBA userform into an Excel sheet.

The userform looks like follows:

IsPresent1(CheckBox11)   Name1(Textbox12)   Surname1(Textbox13)  Age1(Textbox14) ...  
IsPresent2(CheckBox21)   Name2(Textbox22)   Surname2(Textbox23)  Age2(Textbox24) ...  
IsPresent3(CheckBox31)   Name3(Textbox32)   Surname3(Textbox33)  Age3(Textbox34) ...  
...                      ...                ...                  ...

So in case the first checkbox is ticked, other data in the same row will be filled into the Excel worksheet with the VBA code.

I am looking for a loop iterating over rows in the userform like this:

For i = 1 to 100
    If Userform1.Checkboxi1 Then
         Worksheets("Sheet1").Cells(newrow, 1).Value = Userform1.Textboxi2.Value
         Worksheets("Sheet1").Cells(newrow, 2).Value = Userform1.Textboxi3.Value
         ...
    End If
Next i

As I see, it's not easy to iterate variables with different suffixes in VBA, especially if the variables name are set in the Userform, which has several restrictions.

Is there any way to avoid writing the same code a hundred times and adjusting a hundred lines each time the code is adjusted?

Warcupine Warcupine · Accepted Answer · 2021-03-24T12:36:55

This can be done, it might be easier to give a prefix that is the same across rows, but it doesn't really matter. I wasn't sure how you were outputting so I used the last digit in the name as the column number.

This uses a dictionary to keep the textboxes in a row on the sheet.

    Dim ctl As Control
    Dim outputrow As Long
    Dim dict As Object
    Dim ctlnamechar As String
    
    Set dict = CreateObject("Scripting.Dictionary")
    outputrow = 2
    For Each ctl In Me.Controls
        If TypeName(ctl) = "CheckBox" And ctl.Value = True Then
            ctlnamechar = Left(Right(ctl.Name, 2), 1) 'Get the "Row"
            dict.Add ctlnamechar, outputrow
            outputrow = outputrow + 1 'Keep rows in userform together
        End If
    Next ctl
    
    With Sheet1
        For Each ctl In Me.Controls
            If TypeName(ctl) = "TextBox" Then
                ctlnamechar = Left(Right(ctl.Name, 2), 1)
                If dict.exists(ctlnamechar) Then
                    'Using the last digit as the column number
                    .Cells(dict(ctlnamechar), CLng(Right(ctl.Name, 1))).Value = ctl.Value
                End If
            End If
        Next ctl
    End With

Loop through userform textboxes named with different suffixes

1 Answers