B
Ben McClave
Jerry,
This may be more than you were looking for, but the code copied below will create a userform with a listbox containing the column headings and a button. To use this, you'll need to name the range containing your headers (in the code below, the range is named "HeaderRange").
When this code runs, a form will display that allows users to select columns from the "HeaderRange". Clicking the button on the userform will generate a string with each selection separated by a semi-colon (. The string is displayed as a message box, but you could adapt the code to either fill an array or use text-to-columns (or Split) to separate the individual components. After the message displays, the userform is deleted.
The end result is that the code shows a form and captures the items that a user selects. I hope this helps get you started.
Ben
Sub NewUserForm()
'adapted from http://www.mrexcel.com/forum/excel-questions/ _
219814-create-user-form-list-box-using-visual- _
basic-applications-code-only.html
Dim frmNew
Dim cmdContinue As MSForms.CommandButton
Dim strCode As String
Application.VBE.MainWindow.Visible = False
'Generate a string with code for UserForm Module
strCode = "Private Sub UserForm_Activate()" & vbLf
strCode = strCode & "Dim c as Range, x as Long" & vbLf
strCode = strCode & "For Each c In [HeaderRange]" & vbLf
strCode = strCode & " With Me.ListBox1" & vbLf
strCode = strCode & " .AddItem" & vbLf
strCode = strCode & " .List(x, 0) = c.Value" & vbLf
strCode = strCode & " End With" & vbLf
strCode = strCode & " x = x + 1" & vbLf
strCode = strCode & "Next c" & vbLf
strCode = strCode & "With Me.ListBox1" & vbLf
strCode = strCode & " .MultiSelect = fmMultiSelectMulti" & vbLf
strCode = strCode & " .Width = 135" & vbLf
strCode = strCode & " .Left = 18" & vbLf
strCode = strCode & " .Top = 18" & vbLf
strCode = strCode & " .Height = 71" & vbLf
strCode = strCode & "End With" & vbLf
strCode = strCode & "With Me.cmdContinue" & vbLf
strCode = strCode & " .Caption = ""Select Column(s) and Click Here toContinue""" & vbLf
strCode = strCode & " .Width = 157" & vbLf
strCode = strCode & " .Left = 12" & vbLf
strCode = strCode & " .Top = 100" & vbLf
strCode = strCode & " .Height = 50" & vbLf
strCode = strCode & " .WordWrap = TRUE" & vbLf
strCode = strCode & "End With" & vbLf
strCode = strCode & "With Me" & vbLf
strCode = strCode & " .Width = 180" & vbLf
strCode = strCode & " .Height = 180" & vbLf
strCode = strCode & " .Caption = ""Select Column(s)""" & vbLf
strCode = strCode & "End With" & vbLf
strCode = strCode & "End Sub" & vbLf & vbLf
strCode = strCode & " Private Sub cmdContinue_Click() " & vbLf
strCode = strCode & " Dim strTemp As String " & vbLf
strCode = strCode & " Dim lngIndex As Long " & vbLf
strCode = strCode & " " & vbLf
strCode = strCode & " For lngIndex = 0 To ListBox1.ListCount - 1 " & vbLf
strCode = strCode & " If ListBox1.Selected(lngIndex) Then " & vbLf
strCode = strCode & " strTemp = strTemp & ListBox1.List(lngIndex)" & _
" & "";"" " & vbLf
strCode = strCode & " End If " & vbLf
strCode = strCode & " Next " & vbLf
strCode = strCode & " If Len(strTemp) > 0 Then _ " & vbLf
strCode = strCode & " strTemp = Left(strTemp, Len(strTemp) - 1) " & vbLf
strCode = strCode & " MsgBox strTemp " & vbLf
strCode = strCode & " Unload Me " & vbLf
strCode = strCode & " End Sub "
'Create UserForm
Set frmNew = ThisWorkbook.VBProject.VBComponents.Add(3)
With frmNew
ThisWorkbook.VBProject.VBComponents(.Name).CodeModule.AddFromString strCode
.Designer.Controls.Add ("forms.ListBox.1")
Set cmdContinue = .Designer.Controls.Add("forms.CommandButton.1")
cmdContinue.Name = "cmdContinue"
VBA.UserForms.Add(.Name).Show
End With
'Delete Userform
With ThisWorkbook.VBProject.VBComponents
.Remove .Item(frmNew.Name)
End With
End Sub
This may be more than you were looking for, but the code copied below will create a userform with a listbox containing the column headings and a button. To use this, you'll need to name the range containing your headers (in the code below, the range is named "HeaderRange").
When this code runs, a form will display that allows users to select columns from the "HeaderRange". Clicking the button on the userform will generate a string with each selection separated by a semi-colon (. The string is displayed as a message box, but you could adapt the code to either fill an array or use text-to-columns (or Split) to separate the individual components. After the message displays, the userform is deleted.
The end result is that the code shows a form and captures the items that a user selects. I hope this helps get you started.
Ben
Sub NewUserForm()
'adapted from http://www.mrexcel.com/forum/excel-questions/ _
219814-create-user-form-list-box-using-visual- _
basic-applications-code-only.html
Dim frmNew
Dim cmdContinue As MSForms.CommandButton
Dim strCode As String
Application.VBE.MainWindow.Visible = False
'Generate a string with code for UserForm Module
strCode = "Private Sub UserForm_Activate()" & vbLf
strCode = strCode & "Dim c as Range, x as Long" & vbLf
strCode = strCode & "For Each c In [HeaderRange]" & vbLf
strCode = strCode & " With Me.ListBox1" & vbLf
strCode = strCode & " .AddItem" & vbLf
strCode = strCode & " .List(x, 0) = c.Value" & vbLf
strCode = strCode & " End With" & vbLf
strCode = strCode & " x = x + 1" & vbLf
strCode = strCode & "Next c" & vbLf
strCode = strCode & "With Me.ListBox1" & vbLf
strCode = strCode & " .MultiSelect = fmMultiSelectMulti" & vbLf
strCode = strCode & " .Width = 135" & vbLf
strCode = strCode & " .Left = 18" & vbLf
strCode = strCode & " .Top = 18" & vbLf
strCode = strCode & " .Height = 71" & vbLf
strCode = strCode & "End With" & vbLf
strCode = strCode & "With Me.cmdContinue" & vbLf
strCode = strCode & " .Caption = ""Select Column(s) and Click Here toContinue""" & vbLf
strCode = strCode & " .Width = 157" & vbLf
strCode = strCode & " .Left = 12" & vbLf
strCode = strCode & " .Top = 100" & vbLf
strCode = strCode & " .Height = 50" & vbLf
strCode = strCode & " .WordWrap = TRUE" & vbLf
strCode = strCode & "End With" & vbLf
strCode = strCode & "With Me" & vbLf
strCode = strCode & " .Width = 180" & vbLf
strCode = strCode & " .Height = 180" & vbLf
strCode = strCode & " .Caption = ""Select Column(s)""" & vbLf
strCode = strCode & "End With" & vbLf
strCode = strCode & "End Sub" & vbLf & vbLf
strCode = strCode & " Private Sub cmdContinue_Click() " & vbLf
strCode = strCode & " Dim strTemp As String " & vbLf
strCode = strCode & " Dim lngIndex As Long " & vbLf
strCode = strCode & " " & vbLf
strCode = strCode & " For lngIndex = 0 To ListBox1.ListCount - 1 " & vbLf
strCode = strCode & " If ListBox1.Selected(lngIndex) Then " & vbLf
strCode = strCode & " strTemp = strTemp & ListBox1.List(lngIndex)" & _
" & "";"" " & vbLf
strCode = strCode & " End If " & vbLf
strCode = strCode & " Next " & vbLf
strCode = strCode & " If Len(strTemp) > 0 Then _ " & vbLf
strCode = strCode & " strTemp = Left(strTemp, Len(strTemp) - 1) " & vbLf
strCode = strCode & " MsgBox strTemp " & vbLf
strCode = strCode & " Unload Me " & vbLf
strCode = strCode & " End Sub "
'Create UserForm
Set frmNew = ThisWorkbook.VBProject.VBComponents.Add(3)
With frmNew
ThisWorkbook.VBProject.VBComponents(.Name).CodeModule.AddFromString strCode
.Designer.Controls.Add ("forms.ListBox.1")
Set cmdContinue = .Designer.Controls.Add("forms.CommandButton.1")
cmdContinue.Name = "cmdContinue"
VBA.UserForms.Add(.Name).Show
End With
'Delete Userform
With ThisWorkbook.VBProject.VBComponents
.Remove .Item(frmNew.Name)
End With
End Sub