I have a list box (lbxStN) with 3 columns (0-fmMultiSelectSingle).
I would like to make a selection (only one) in this list, and have the data from each column of the list shown in a specific cell in a specific sheet (sheet: DeN). First column from the list F19, second column C22 and third column H22. After button (cmdBtnSelect2) is clicked.
Data for the list box is stored in a different sheet in the same workbook.
Private Sub cmdBtnSelect2_Click()
Dim i As Long
Dim myVar4 As String
Dim myVar5 As String
Dim myVar6 As String
For i = 0 To lbxStN.ListCount - 1
If lbxStN.Selected(i) = True Then
lbxStN.List(i, 0).Value = myVar4
lbxStN.List(i, 1).Value = myVar5
lbxStN.List(i, 2).Value = myVar6
End If
Next
ThisWorkbook.Sheets("DeN").Range("F19") = myVar4
ThisWorkbook.Sheets("DeN").Range("C22") = myVar5
ThisWorkbook.Sheets("DeN").Range("H22") = myVar6
End Sub
If I run the code, I get a '424' Object required error.
Which means I'm missing something basic.?
For what you intend to do, there is no need to create new variables. The value from the selected item can be assigned directly to the cells. As follows
Private Sub cmdBtnSelect2_Click()
Dim i as Integer
For i = 0 To lbxStN.ListCount - 1
If lbxStN.Selected(i) Then
ThisWorkbook.Sheets("DeN").Range("F19") = lbxStN.List(i, 0)
ThisWorkbook.Sheets("DeN").Range("C22") = lbxStN.List(i, 1)
ThisWorkbook.Sheets("DeN").Range("H22") = lbxStN.List(i, 2)
Exit For
End If
Next i
End Sub
The previous subroutine iterates for each iteam in the list, and checks if the item is selected. If the item is selected, then it assigns each column to each cell. Exit For will exit the iteration, because there is no need to continue looking for more selected items.
I tested the code with the following subroutine to add items to the list. I think it would be a good idea to compare it with yours in case you have tried to do a complex assignment.
Private Sub CommandButton1_Click()
lbxStN.Clear
lbxStN.AddItem "a"
lbxStN.List(lbxStN.ListCount - 1, 1) = "a2"
lbxStN.List(lbxStN.ListCount - 1, 2) = "a3"
lbxStN.AddItem "b"
lbxStN.List(lbxStN.ListCount - 1, 1) = "b2"
lbxStN.List(lbxStN.ListCount - 1, 2) = "b3"
lbxStN.AddItem "c"
lbxStN.List(lbxStN.ListCount - 1, 1) = "c2"
lbxStN.List(lbxStN.ListCount - 1, 2) = "c3"
End Sub
I usually get better at coding by reading someone elses code and trying to understand it
Cheers!
I am quite new to programming and VBA but I have been using a lot of help questions and answers here on stack overflow to learn! I am attempting to create a loop that will determine if a value from a "task" sheet is missing from a "preview" sheet and if so to add the number and line to the "preview" sheet from the "task" sheet. For an example of the data on each sheet:
Task Sheet
TASK VALUE description
11 task 1
12 task 2
13 task 3
Preview Sheet
PREVIEW VALUE Description
1111 preview 1
2222 preview 2
11 task 1
3333 preview 3
13 task 3
The aim is to compare each number in the preview sheet to each value in the task sheet. If a value in the task sheet is not found in the preview sheet, then it should add that value and the entire line into the preview sheet from the task sheet.
My main approach was to create a for loop that would compare each number on the "preview" sheet to each value on the "task" sheet. If it found that two values matched, it would set the variable newTask = False and then exit the nested for loop to move on to the next comparison. If it found that the value from the data sheet was not present in the main sheet, it would set newTask = True and run through until there was no more values to compare. Then, if newTask = True, it would copy and paste the value and line from the data sheet into the main sheet. This is my attempt at coding this:
Dim newTask As Boolean
iP = (Worksheets("parents").Columns("a").Cells.SpecialCells(xlCellTypeConstants).Count) - 1 'count of parent workorders
iC = (Worksheets("child").Columns("a").Cells.SpecialCells(xlCellTypeConstants).Count) - 1 ' count of child workorders
iT = (Worksheets("task").Columns("a").Cells.SpecialCells(xlCellTypeConstants).Count) - 1 ' count of task workorders
iPr = (Worksheets("preview").Columns("a").Cells.SpecialCells(xlCellTypeConstants).Count) + 1 ' this will set iPr one row below the last row on the preview page
nT = 0
Set prRng = Sheets("Preview").Range(Sheets("Preview").Cells(iPr, 1), Sheets("Preview").Cells(iPr, 11))
For n = 1 To iPr
taskWO = Worksheets("task").Cells(n + 1, 1).Value
For nT = 1 To iT
previewWO = Worksheets("preview").Cells(nT + 1, 1).Value
If previewWO = taskWO Then
newTask = False
Exit For
ElseIf previewWO <> taskWO Then
newTask = True
End If
Next nT
If newTask = True Then
Set tRng = Sheets("task").Range(Sheets("task").Cells(n + 1, 1), Sheets("task").Cells(n + 1, 11))
Sheets("Preview").Range(Sheets("Preview").Cells(iPr, 1), Sheets("Preview").Cells(iPr, 11)) = tRng.Value
Sheets("Preview").Cells(iPr, 12) = Sheets("task").Cells(n + 1, 13).Value
iPr = (Worksheets("preview").Columns("a").Cells.SpecialCells(xlCellTypeConstants).Count) + 1
End If
Next n
However, when I run this code, it keeps newTask = True, even if the values do match across the preview and task sheets. Debugging confirmed this and if it comes across similar values, it just continues over it as if they do not equal each other. This causes all values from the task sheet to copy over to the preview sheet, adding many duplicates. I also attempted a Do Until loop but get the same results: Here is my attempt at that:
Dim newTask As Boolean
iP = (Worksheets("parents").Columns("a").Cells.SpecialCells(xlCellTypeConstants).Count) - 1 'count of parent workorders
iC = (Worksheets("child").Columns("a").Cells.SpecialCells(xlCellTypeConstants).Count) - 1 ' count of child workorders
iT = (Worksheets("task").Columns("a").Cells.SpecialCells(xlCellTypeConstants).Count) - 1 ' count of task workorders
iPr = (Worksheets("preview").Columns("a").Cells.SpecialCells(xlCellTypeConstants).Count) + 1 ' this will set iPr one row below the last row on the preview page
nT = 0
taskWO = Worksheets("task").Cells(n + 1, 1).Value
Set prRng = Sheets("Preview").Range(Sheets("Preview").Cells(iPr, 1), Sheets("Preview").Cells(iPr, 11))
For n = 1 To iPr
taskWO = Worksheets("task").Cells(n + 1, 1).Value
Do Until taskWO = previewWO Or nT = iT
previewWO = Worksheets("preview").Cells(nT + 1, 1).Value
nT = nT + 1
If nT = iT Then
Set tRng = Sheets("task").Range(Sheets("task").Cells(n + 1, 1), Sheets("task").Cells(n + 1, 11))
Sheets("Preview").Range(Sheets("Preview").Cells(iPr, 1), Sheets("Preview").Cells(iPr, 11)) = tRng.Value
Sheets("Preview").Cells(iPr, 12) = Sheets("task").Cells(n + 1, 13).Value
iPr = (Worksheets("preview").Columns("a").Cells.SpecialCells(xlCellTypeConstants).Count) + 1
End If
Loop
Next n
I have done a lot of searching but I cannot find any way to get this to stop duplicating values... but I apologize if I missed a thread that has this information or help. I feel like it is something simple but I just cannot figure it out. Could I please get some help on how to correct this? If this is not the correct method, could you also please mention why the loop does not work or what went wrong so I can know in the future? Thank you for any help you provide! If you need some more information, please let me know.
Kyle, without being a complete re-work of your code, here's some code that I think might help you out. If I understand your problem correctly, the main issue you're having is that you're unable to properly determine if a value in one range exists in another. When I have this issue, I usually will use a dictionary object because it's fast, and provides an easy way to check if a value is in a list. To use a dictionary, however, you'll likely have to add a reference to it first. To do this, go to the tools menu and select "References". Scroll down until you've found "Microsoft Scripting Runtime" and select that item. After that, the following code should run just fine.
Sub Testq()
Set Dict = New Dictionary
For Each Cel In Worksheets("preview").Columns(1).SpecialCells(xlCellTypeConstants)
'Add the "Preview Values" of all the cells into your dictionary as Keys.
'Set the value of each key to the "Description" which is in the row next to it.
Dict(Trim(Cel.Value)) = Trim(Cells(Cel.Row(), 2))
Next
'Lets add in the header row of the task worksheet to prevent it from getting coppied over.
Dict(Worksheets("task").Cells(1, 1).Value) = Worksheets("task").Cells(1, 2).Value
'Now loop through all of the values in your "Task" table, checking them against the Dictionary
'to see if there are any new ones.
For Each Cel In Worksheets("Task").Columns(1).SpecialCells(xlCellTypeConstants)
If Not Dict.Exists(Trim(Cel.Value)) Then 'We have a new value.
TaskValue = Trim(Cel.Value)
Description = Trim(Worksheets("Task").Cells(Cel.Row(), 2))
Debug.Print "Yup, I found one that's missing: " & Trim(TaskValue)
'Now add the missing value to the end of your "preview" sheet.
LastRow = Worksheets("preview").Cells(Range("A:A").Rows.Count, "A").End(xlUp).Row
Worksheets("preview").Cells(LastRow + 1, 1) = Trim(TaskValue)
Worksheets("preview").Cells(LastRow + 1, 2) = Trim(Description)
End If
Next
End Sub
Since you mentioned that you're new to VBA, I'll point out that to view the output of the Debug.Print statement, you'll need to display the "Immediate" window. Do this by selecting it from the View menu. As I get a clearer picture of your project, I'll supplement this answer as needed, but for now I hope this will help you solve much of the problem you're having.
Is it possible to set up the headers in a multicolumn listbox without using a worksheet range as the source?
The following uses an array of variants which is assigned to the list property of the listbox, the headers appear blank.
Sub testMultiColumnLb()
ReDim arr(1 To 3, 1 To 2)
arr(1, 1) = "1"
arr(1, 2) = "One"
arr(2, 1) = "2"
arr(2, 2) = "Two"
arr(3, 1) = "3"
arr(3, 2) = "Three"
With ufTestUserForm.lbTest
.Clear
.ColumnCount = 2
.List = arr
End With
ufTestUserForm.Show 1
End Sub
Here is my approach to solve the problem:
This solution requires you to add a second ListBox element and place it above the first one.
Like this:
Then you call the function CreateListBoxHeader to make the alignment correct and add header items.
Result:
Code:
Public Sub CreateListBoxHeader(body As MSForms.ListBox, header As MSForms.ListBox, arrHeaders)
' make column count match
header.ColumnCount = body.ColumnCount
header.ColumnWidths = body.ColumnWidths
' add header elements
header.Clear
header.AddItem
Dim i As Integer
For i = 0 To UBound(arrHeaders)
header.List(0, i) = arrHeaders(i)
Next i
' make it pretty
body.ZOrder (1)
header.ZOrder (0)
header.SpecialEffect = fmSpecialEffectFlat
header.BackColor = RGB(200, 200, 200)
header.Height = 10
' align header to body (should be done last!)
header.Width = body.Width
header.Left = body.Left
header.Top = body.Top - (header.Height - 1)
End Sub
Usage:
Private Sub UserForm_Activate()
Call CreateListBoxHeader(Me.listBox_Body, Me.listBox_Header, Array("Header 1", "Header 2"))
End Sub
No. I create labels above the listbox to serve as headers. You might think that it's a royal pain to change labels every time your lisbox changes. You'd be right - it is a pain. It's a pain to set up the first time, much less changes. But I haven't found a better way.
I was looking at this problem just now and found this solution. If your RowSource points to a range of cells, the column headings in a multi-column listbox are taken from the cells immediately above the RowSource.
Using the example pictured here, inside the listbox, the words Symbol and Name appear as title headings. When I changed the word Name in cell AB1, then opened the form in the VBE again, the column headings changed.
The example came from a workbook in VBA For Modelers by S. Christian Albright, and I was trying to figure out how he got the column headings in his listbox :)
Simple answer: no.
What I've done in the past is load the headings into row 0 then set the ListIndex to 0 when displaying the form. This then highlights the "headings" in blue, giving the appearance of a header. The form action buttons are ignored if the ListIndex remains at zero, so these values can never be selected.
Of course, as soon as another list item is selected, the heading loses focus, but by this time their job is done.
Doing things this way also allows you to have headings that scroll horizontally, which is difficult/impossible to do with separate labels that float above the listbox. The flipside is that the headings do not remain visible if the listbox needs to scroll vertically.
Basically, it's a compromise that works in the situations I've been in.
There is very easy solution to show headers at the top of multi columns list box.
Just change the property value to "true" for "columnheads" which is false by default.
After that Just mention the data range in property "rowsource" excluding header from the data range and header should be at first top row of data range then it will pick the header automatically and you header will be freezed.
if suppose you have data in range "A1:H100" and header at "A1:H1" which is the first row then your data range should be "A2:H100" which needs to mention in property "rowsource" and "columnheads" perperty value should be true
Regards,
Asif Hameed
Just use two Listboxes, one for header and other for data
for headers - set RowSource property to top row e.g. Incidents!Q4:S4
for data - set Row Source Property to Incidents!Q5:S10
SpecialEffects to "3-frmSpecialEffectsEtched"
I like to use the following approach for headers on a ComboBox where the CboBx is not loaded from a worksheet (data from sql for example). The reason I specify not from a worksheet is that I think the only way to get RowSource to work is if you load from a worksheet.
This works for me:
Create your ComboBox and create a ListBox with an identical layout but just one row.
Place the ListBox directly on top of the ComboBox.
In your VBA, load ListBox row1 with the desired headers.
In your VBA for the action yourListBoxName_Click, enter the following code:
yourComboBoxName.Activate`
yourComboBoxName.DropDown`
When you click on the listbox, the combobox will drop down and function normally while the headings (in the listbox) remain above the list.
I was searching for quite a while for a solution to add a header without using a separate sheet and copy everything into the userform.
My solution is to use the first row as header and run it through an if condition and add additional items underneath.
Like that:
If lborowcount = 0 Then
With lboorder
.ColumnCount = 5
.AddItem
.Column(0, lborowcount) = "Item"
.Column(1, lborowcount) = "Description"
.Column(2, lborowcount) = "Ordered"
.Column(3, lborowcount) = "Rate"
.Column(4, lborowcount) = "Amount"
End With
lborowcount = lborowcount + 1
End If
With lboorder
.ColumnCount = 5
.AddItem
.Column(0, lborowcount) = itemselected
.Column(1, lborowcount) = descriptionselected
.Column(2, lborowcount) = orderedselected
.Column(3, lborowcount) = rateselected
.Column(4, lborowcount) = amountselected
End With
lborowcount = lborowcount + 1
in that example lboorder is the listbox, lborowcount counts at which row to add the next listbox item. It's a 5 column listbox. Not ideal but it works and when you have to scroll horizontally the "header" stays above the row.
Here's my solution.
I noticed that when I specify the listbox's rowsource via the properties window in the VBE, the headers pop up no problem. Its only when we try define the rowsource through VBA code that the headers get lost.
So I first went a defined the listboxes rowsource as a named range in the VBE for via the properties window, then I can reset the rowsource in VBA code after that. The headers still show up every time.
I am using this in combination with an advanced filter macro from a listobject, which then creates another (filtered) listobject on which the rowsource is based.
This worked for me
Another variant on Lunatik's response is to use a local boolean and the change event so that the row can be highlighted upon initializing, but deselected and blocked after a selection change is made by the user:
Private Sub lbx_Change()
If Not bHighlight Then
If Me.lbx.Selected(0) Then Me.lbx.Selected(0) = False
End If
bHighlight = False
End Sub
When the listbox is initialized you then set bHighlight and lbx.Selected(0) = True, which will allow the header-row to initialize selected; afterwards, the first change will deselect and prevent the row from being selected again...
Here's one approach which automates creating labels above each column of a listbox (on a worksheet).
It will work (though not super-pretty!) as long as there's no horizontal scrollbar on your listbox.
Sub Tester()
Dim i As Long
With Me.lbTest
.Clear
.ColumnCount = 5
'must do this next step!
.ColumnWidths = "70;60;100;60;60"
.ListStyle = fmListStylePlain
Debug.Print .ColumnWidths
For i = 0 To 10
.AddItem
.List(i, 0) = "blah" & i
.List(i, 1) = "blah"
.List(i, 2) = "blah"
.List(i, 3) = "blah"
.List(i, 4) = "blah"
Next i
End With
LabelHeaders Me.lbTest, Array("Header1", "Header2", _
"Header3", "Header4", "Header5")
End Sub
Sub LabelHeaders(lb, arrHeaders)
Const LBL_HT As Long = 15
Dim T, L, shp As Shape, cw As String, arr
Dim i As Long, w
'delete any previous headers for this listbox
For i = lb.Parent.Shapes.Count To 1 Step -1
If lb.Parent.Shapes(i).Name Like lb.Name & "_*" Then
lb.Parent.Shapes(i).Delete
End If
Next i
'get an array of column widths
cw = lb.ColumnWidths
If Len(cw) = 0 Then Exit Sub
cw = Replace(cw, " pt", "")
arr = Split(cw, ";")
'start points for labels
T = lb.Top - LBL_HT
L = lb.Left
For i = LBound(arr) To UBound(arr)
w = CLng(arr(i))
If i = UBound(arr) And (L + w) < lb.Width Then w = lb.Width - L
Set shp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, _
L, T, w, LBL_HT)
With shp
.Name = lb.Name & "_" & i
'do some formatting
.Line.ForeColor.RGB = vbBlack
.Line.Weight = 1
.Fill.ForeColor.RGB = RGB(220, 220, 220)
.TextFrame2.TextRange.Characters.Text = arrHeaders(i)
.TextFrame2.TextRange.Font.Size = 9
.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = vbBlack
End With
L = L + w
Next i
End Sub
You can give this a try. I am quite new to the forum but wanted to offer something that worked for me since I've gotten so much help from this site in the past. This is essentially a variation of the above, but I found it simpler.
Just paste this into the Userform_Initialize section of your userform code. Note you must already have a listbox on the userform or have it created dynamically above this code. Also please note the Array is a list of headings (below as "Header1", "Header2" etc. Replace these with your own headings. This code will then set up a heading bar at the top based on the column widths of the list box. Sorry it doesn't scroll - it's fixed labels.
More senior coders - please feel free to comment or improve this.
Dim Mywidths As String
Dim Arrwidths, Arrheaders As Variant
Dim ColCounter, Labelleft As Long
Dim theLabel As Object
[Other code here that you would already have in the Userform_Initialize section]
Set theLabel = Me.Controls.Add("Forms.Label.1", "Test" & ColCounter, True)
With theLabel
.Left = ListBox1.Left
.Top = ListBox1.Top - 10
.Width = ListBox1.Width - 1
.Height = 10
.BackColor = RGB(200, 200, 200)
End With
Arrheaders = Array("Header1", "Header2", "Header3", "Header4")
Mywidths = Me.ListBox1.ColumnWidths
Mywidths = Replace(Mywidths, " pt", "")
Arrwidths = Split(Mywidths, ";")
Labelleft = ListBox1.Left + 18
For ColCounter = LBound(Arrwidths) To UBound(Arrwidths)
If Arrwidths(ColCounter) > 0 Then
Header = Header + 1
Set theLabel = Me.Controls.Add("Forms.Label.1", "Test" & ColCounter, True)
With theLabel
.Caption = Arrheaders(Header - 1)
.Left = Labelleft
.Width = Arrwidths(ColCounter)
.Height = 10
.Top = ListBox1.Top - 10
.BackColor = RGB(200, 200, 200)
.Font.Bold = True
End With
Labelleft = Labelleft + Arrwidths(ColCounter)
End If
Next
This is a bummer. Have to use an intermediate sheet to put the data in so Excel knows to grab the headers. But I wanted that workbook to be hidden so here's how I had to do the rowsource.
Most of this code is just setting things up...
Sub listHeaderTest()
Dim ws As Worksheet
Dim testarr() As String
Dim numberOfRows As Long
Dim x As Long, n As Long
'example sheet
Set ws = ThisWorkbook.Sheets(1)
'example headers
For x = 1 To UserForm1.ListBox1.ColumnCount
ws.Cells(1, x) = "header" & x
Next x
'example array dimensions
numberOfRows = 15
ReDim testarr(numberOfRows, UserForm1.ListBox1.ColumnCount - 1)
'example values for the array/listbox
For n = 0 To UBound(testarr)
For x = 0 To UBound(testarr, 2)
testarr(n, x) = "test" & n & x
Next x
Next n
'put array data into the worksheet
ws.Range("A2").Resize(UBound(testarr), UBound(testarr, 2) + 1) = testarr
'provide rowsource
UserForm1.ListBox1.RowSource = "'[" & ws.Parent.Name & "]" & ws.Name & "'!" _
& ws.Range("A2").Resize(ws.UsedRange.Rows.Count - 1, ws.UsedRange.Columns.Count).Address
UserForm1.Show
End Sub
For scrolling, one idea is to create a simulated scroll bar which would shift the entire listbox left and right.
ensure the list box is set to full width so the horizontal scroll
bar doesn't appear (wider than the space available, or we wouldn't
need to scroll)
add a scroll bar control at the bottom but with .left and .width to
match the available horizontal space (so not as wide as the too-wide listbox)
calculate the distance you need to scroll as the difference between
the width of the extended list box and the width of the available
horizontal space
set .Min to 0 and .Max to the amount you need to scroll
set .LargeChange to make the slider-bar wider (I could only get it
to be half of the total span)
For this to work, you'd need to be able to cover left and right of the intended viewing space with a frame so that the listbox can pass underneath it and preserve any horizontal framing in the form. This turn out to be challenging, as getting a frame to cover a listbox seems not to work easily. I gave up at that point but am sharing these steps for posterity.
I found a way that seems to work but it can get messy the more complicated your code gets if you're dynamically clearing the range after every search or changing range.
Spreadsheet:
A B C
1 LName Fname
2 Smith Bob
set rng_Name = ws_Name.range("A1", ws_Name.range("C2").value
lstbx.Main.rowsource = rng_Name.Address
This will loads the Headers into the listbox and allow you to scroll.
Most importantly, if you're looping through your data and your range comes up empty, then your listbox won't load the headers correctly, so you will have to account for no "matches".
Why not just add Labels to the top of the Listbox and if changes are needed, the only thing you need to programmatically change are the labels.
I have an ActiveX listbox on an Excel 2007 worksheet. I want to populate it directly, not by pointing its RowSource property to a range, because there is no range that has the desired values.
The listbox's ColumnCount is set to 2.
I set ColumnWidths to "20;20", and now it returns:
20 pt;20 pt
So as far as I understand, two columns in the listbox should be available for writing, right?
Populating the first column is no problem:
activesheet.lstApplyCurves.List = array("Select All","Deselect All","aaa","bbb","ccc")
(or)
activesheet.lstApplyCurves.additem
activesheet.lstApplyCurves.List(0,0) = "Col1, Row1"
But how do I populate column 2? I get an error 380 ("Could not set the list property. Invalid property value.") on this:
activesheet.lstApplyCurves.List(0,1) = "Col2, Row1"
FWIW I've also tried this, but get the same error:
activesheet.lstApplyCurves.List(1,1) = "Col2, Row2"
So...how do I set values in the 2nd column?
UPDATE:
In addition to the answer below, FWIW I also found it's possible to assign a mulit-dimensional array to the List property, which is faster:
Dim ArrayToListbox() As Variant
ReDim ArrayToListbox(0 To 4, 0 To 2)
ArrayToListbox(0, 0) = "Select All"
ArrayToListbox(1, 0) = "Deselect All"
ArrayToListbox(2, 0) = "Row1-Col1"
ArrayToListbox(2, 1) = "Row1-Col2"
ArrayToListbox(2, 2) = "Row1-Col3"
ArrayToListbox(3, 0) = "Row2-Col1"
ArrayToListbox(3, 1) = "Row2-Col2"
ArrayToListbox(3, 2) = "Row2-Col3"
ArrayToListbox(4, 0) = "Row3-Col1"
ArrayToListbox(4, 1) = "Row3-Col2"
ArrayToListbox(4, 2) = "Row3-Col3" '"(" & Join(Array("a", "b", "c"), "|") & ")"
ActiveSheet.lstApplyCurves.Clear
ActiveSheet.lstApplyCurves.ColumnCount = 3
ActiveSheet.lstApplyCurves.List = ArrayToListbox
This works for me. If the below doesn't work on your system then delete the listbox and re-create it and then try this code again.
Private Sub CommandButton1_Click()
With ListBox1
.Clear
.ColumnCount = 2
For i = 1 To 2
.AddItem
.List(i - 1, 0) = "Col1, Row" & i
.List(i - 1, 1) = "Col2, Row" & i
Next i
End With
End Sub