Loop for checkbox's that are true and return the caption of each true checkbox in a seperate row of the same column

sthyne

New Member
Joined
Jun 25, 2018
Messages
6
I have a formula that loops through the checkboxes and places the captions as consecutive strings separated by a comma in the next column. I need to modify it so that each checkbox that is true is input on a separate row

VBA Code:
Private Sub CommandButton1_Click()

Dim ans As String

Dim emptyrow As Long

For Each xcontrol In Me.Controls

If TypeName(xcontrol) = "CheckBox" Then

If xcontrol.Value = True Then ans = ans & xcontrol.Caption & "," & " "

End If

Next xcontrol

If ans = "" Then

MsgBox "You selected no CheckBoxes"

Else

ActiveCell.Offset(0, 1).Value = Left(ans, Len(ans) - 1)



End If

Unload Me

End Sub
 

Excel Facts

Show numbers in thousands?
Use a custom number format of #,##0,K. Each comma after the final 0 will divide the displayed number by another thousand
Two methods below

VBA Code:
Private Sub CommandButton1_Click()
 Dim ct, sq
 For Each ct In Me.Controls
   If TypeName(ct) = "CheckBox" Then
      If ct Then sq = sq & IIf(sq = "", "", ",") & ct.Caption
   End If
 Next
 With Sheets(1).Cells(1, 1)
   .Resize(30).ClearContents
   .Resize(UBound(Split(sq, ",")) + 1) = Application.Transpose(Split(sq, ","))
 End With
End Sub

VBA Code:
Private Sub CommandButton1_Click()
 Dim sq(), ct, x
 For Each ct In Me.Controls
   If TypeName(ct) = "CheckBox" Then
      If ct Then
        ReDim Preserve sq(x)
        sq(x) = ct.Caption: x = x + 1
      End If
   End If
 Next
 With Sheets(1).Cells(1, 1)
    .Resize(30).ClearContents
    .Resize(x) = Application.Transpose(sq)
 End With
End Sub
 
Upvote 0
Two methods below

VBA Code:
Private Sub CommandButton1_Click()
 Dim ct, sq
 For Each ct In Me.Controls
   If TypeName(ct) = "CheckBox" Then
      If ct Then sq = sq & IIf(sq = "", "", ",") & ct.Caption
   End If
 Next
 With Sheets(1).Cells(1, 1)
   .Resize(30).ClearContents
   .Resize(UBound(Split(sq, ",")) + 1) = Application.Transpose(Split(sq, ","))
 End With
End Sub

VBA Code:
Private Sub CommandButton1_Click()
 Dim sq(), ct, x
 For Each ct In Me.Controls
   If TypeName(ct) = "CheckBox" Then
      If ct Then
        ReDim Preserve sq(x)
        sq(x) = ct.Caption: x = x + 1
      End If
   End If
 Next
 With Sheets(1).Cells(1, 1)
    .Resize(30).ClearContents
    .Resize(x) = Application.Transpose(sq)
 End With
End Sub
Thank you, that worked perfectly.

If I wanted them to always appear in the same column (for example column B) on the next empty row, how would I change the code for that?
 
Upvote 0
For example

VBA Code:
Private Sub CommandButton1_Click()
 Dim sq(), ct, x
 For Each ct In Me.Controls
   If TypeName(ct) = "CheckBox" Then
      If ct Then
        ReDim Preserve sq(x)
        sq(x) = ct.Caption: x = x + 1
      End If
   End If
 Next
 Sheets(1).Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(x) = Application.Transpose(sq)
End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,213,527
Messages
6,114,150
Members
448,552
Latest member
WORKINGWITHNOLEADER

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top