Moving items from Listbox1 to Listbox2 code - excel

So, Listbox1 is populated (from another sub, linked to range of cells in the workbook) and users can select (one at a time) items from that Listbox to be shown in Listbox2, using a Command Button (Add) to move them. I've nearly managed to get it perfect. My problem is that if a user only selects the final entry in Listbox1, all other possible entries in Listbox1 are removed (blanked out/not visible/cannot be selected).
I want only the entry which has been selected from Listbox1 to be removed from Listbox1 as it appears in Listbox2.
Here's the code:
Private Sub Add_Click()
Dim i as Integer
For i = 0 To Me.ListBox1.ListCount - 1
If Me.ListBox1.Selected(i) = True Then
Me.ListBox2.AddItem Me.ListBox1.List(i)
End If
Next i
For i = Me.ListBox1.ListCount - 1 To 0 Step -1
If Me.ListBox1.Selected(i) = True Then
Me.ListBox1.RemoveItem i
End If
Next
End Sub
If there's anything obvious here, I'm really sorry. But these Listboxes have been driving me crazy for about 3 days now.
Thanks in advance

It's a single-select list, so try adding Exit For inside each loop once you've hit the selected item:
Private Sub Add_Click()
Dim i as Long
For i = Me.ListBox1.ListCount - 1 To 0 Step -1
If Me.ListBox1.Selected(i) = True Then
Me.ListBox2.AddItem Me.ListBox1.List(i)
Me.ListBox1.RemoveItem i
Exit For
End If
Next
End Sub

Related

Select / highlight every second pair in UserForm listbox

I am wondering is there any solution to select / highlight every second pair in the list with some piece of code?
I have sat up listbox to MultiSelect:
And I want to achieve something like this:
By clicking button on UserForm:
Private Sub CommandButton1_Click()
' Select every second pair
End Sub
I have tried to play with:
Private Sub CommandButton1_Click()
' Select every second pair
sameCustomerComparison.Selected(1) = True
sameCustomerComparison.Selected(2) = True
sameCustomerComparison.Selected(5) = True
sameCustomerComparison.Selected(6) = True
End Sub
but it is giving an error... debugger pointing at sameCustomerComparison.Selected(1) = True
You could achieve this simply with a loop
Private Sub CommandButton1_Click()
Dim i As Long
With Me.ListBox1
.MultiSelect = fmMultiSelectMulti
For i = 0 To .ListCount - 1 Step 4
If i <= .ListCount Then .Selected(i) = True
If i + 1 <= .ListCount Then .Selected(i + 1) = True
Next i
End With
End Sub

VBA - Listbox Remove all selected and Next Select all

Can someone please tell me why this code won't read past the first next in the code. I'm trying to remove all the items on the list that I've selected manually, this is working but after that I want it to selected all so I can write the hole list to a sheet but no matter what I do I can't get it to selected all after I removed the items from the list. in fact it wont read past the first next how do I know that, because if I set the clear function just before it will clear the sheet but not if I put it after the next code.
Private Sub CommandButton2_Click()
For listIndexCount = 0 To ListBox1.ListCount
If listIndexCount >= ListBox1.ListCount Then
Exit Sub
End If
If ListBox1.Selected(listIndexCount) Then
ListBox1.RemoveItem (listIndexCount)
listIndexCount = listIndexCount - 1
End If
Next listIndexCount
Sheets("Courses_calc").Cells.Clear
For i = 0 To ListBox1.ListCount - 1
ListBox1.Selected(i) = True
Next i
End Sub

Could not set the List property

I have looked for this issue and actually tried to follow some of the solutions but it happens that for some reason it's not working with me.
So I have a dropdown menu (gateway) and a text box (dueDate) and once I select and fill the blank spaces I want to populate a ListBox1 being the 1st column the gateway and 2nd column the dueDate.
this is what I have, but it pops up a window saying:
"Run-time error '381':
Could not set the List property. Invalid property array index."
Private Sub CommandButton2_Click()
'ListBox1.AddItem (gateway.Value)
ListBox1.List(ListCount - 1, 0) = gateway.Value
ListBox1.List(ListCount - 1, 1) = dueDate.Value
End Sub
I have set the ListBox1 BoundColumn and ColumnCount to 2 in the design editor.
Thanks in advance!
EDIT:
Managed to fix it. Based on the first comment to this thread I have used the following.
With ListBox1
ListCount = .ListCount
.AddItem gateway.Value
.List(ListCount, 1) = dueDate.Value
End With
I needed some time to figure this out myself (^.^):
Private Sub CommandButton2_Click()
With ListBox1
ListCount = .ListCount
.AddItem gateway.Value, ListCount -1
.List(ListCount - 1, 0) = dueDate.Value
End With
End Sub
Tell me if it worked.

Prevent duplicates from adding items from Listbox1 to Listbox2 (VBA excel)

I have two ListBoxes. ListBox1 has list of items that can be selected by the user to transfer to ListBox2 by either double clicking the item or pressing the add button. What I want to do now is to prevent the user from adding duplicates in ListBox2. If ever a duplicate is detected a message will prompt "Item already included" and end the code. I am guessing this can be done with contains? But I have no idea how to do it. I have the following codes:
'Report Listing
Private Sub UserForm_Initialize()
'List of Reports
With ListBox1
.AddItem "Report 1"
.AddItem "Report 2"
.AddItem "Report 3"
.AddItem "Report 4"
.AddItem "Report 5"
.AddItem "Report 6"
End With
End Sub
'Add selection to ListBox2
Private Sub AddButton_Click()
With ListBox1
Dim itemIndex As Integer
For itemIndex = .ListCount - 1 To 0 Step -1
If .Selected(itemIndex) Then
ListBox2.AddItem .List(itemIndex)
End If
Next itemIndex
End With
End Sub
'Double click to Add
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ListBox2.AddItem ListBox1.List(ListBox1.ListIndex)
End Sub
Something like this will hopefully help you..
AddValueListbox2 function checks for existence of a value, adds it if it's not there and alerts the user if it is.
NB
This will work if you have multi-select enabled for the list boxes.
Private Sub CommandButton1_Click()
'index is -1 if nothin is selected
If ListBox1.ListIndex = -1 Then Exit Sub
'loop backwards as we're removing items
For i = ListBox1.ListCount - 1 To 0 Step -1
If ListBox1.Selected(i) Then
AddValueListbox2 ListBox1.List(i)
ListBox1.RemoveItem (i)
End If
Next i
End Sub
Private Function AddValueListbox2(str As String)
Dim valExists As Boolean
valExists = False
For i = 0 To ListBox2.ListCount - 1
If ListBox2.List(i) = str Then valExists = True
Next i
If valExists Then
MsgBox str & " has already been added to ListBox", vbInformation
Else
ListBox2.AddItem str
End If
End Function
Private Sub UserForm_Activate()
Dim items(2) As String
items(0) = "foo"
items(1) = "bar"
items(2) = "baz"
For i = LBound(items) To UBound(items)
Me.ListBox1.AddItem items(i)
Next i
End Sub
In case anyone is still interested, there's another way to do this, using a similar technique.
Sub Duplicate()
dim i as integer
dim x as integer
x = 0
For i = 0 to listbox2.count - 1
If listbox2.list(i) = myval Then
x = x + 1
End If
Next i
If x = 0 Then
listbox2.additem myval
End If
End Sub
Where myval is the selected value from listbox1.
Essentially if it finds a single reference to your value in the list, it will start a counter. If no instances of your value are found, it will insert it into the listbox.
Hope this helps someone.

VBA Excel combobox not displaying the value after selecting option

Private Sub ComboBox1_DropButtonClick()
If ComboBox1.ListCount > 0 Then
ActiveSheet.ComboBox1.Clear
End If
For N = 1 To ActiveWorkbook.Sheets.Count - 1
ComboBox1.AddItem ActiveWorkbook.Sheets(N).Name
Next N
End Sub
I'm new to VBA so please bear with me. I may not be doing this the best way to begin with.
The code is taking the names of each sheet in my workbook (with the exception of the last sheet) and adding them to a combobox list. At first, each time I clicked the drop down, all sheet names were being added again making the list continue to grow with every click. My remedy was to clear the combobox first on each click and repopulate.
However, with the clear option being used, the value is not being displayed when making my selection. It displays fine when not using the clear option. Everything else still works, but I need it to show the selected value so users aren't confused.
Is there a better way to accomplish what I need?
EDIT: If it matters, this is not in a user form, it's just a active x combobox located directly on a worksheet.
this is a very strange behavior - but the DopButtonClick event is triggered again when you select the item in the list. Therefore, the value that was just assigned get cleared upon the .Clear in the second run.
This code fixes it:
Private Sub ComboBox1_DropButtonClick()
Dim strValue As String
Dim n As Integer
strValue = ComboBox1.Value
If ComboBox1.ListCount > 0 Then
ActiveSheet.ComboBox1.Clear
End If
For n = 1 To ActiveWorkbook.Sheets.Count - 1
ComboBox1.AddItem ActiveWorkbook.Sheets(n).Name
Next n
ComboBox1.Value = strValue
End Sub
Something like below would work. However, I'd question why you'd want to repopulate the combobox everytime someone clicks on it. Why not do it when the workbook opens or the worksheet is activated?
Private Sub ComboBox1_DropButtonClick(ComboBox1 As ComboBox)
Dim strSelected As String
If ComboBox1.ListIndex > -1 Then
strSelected = ComboBox1.List(ComboBox1.ListIndex)
End If
If ComboBox1.ListCount > 0 Then
ActiveSheet.ComboBox1.Clear
End If
For N = 1 To ActiveWorkbook.Sheets.Count - 1
ComboBox1.AddItem ActiveWorkbook.Sheets(N).Name
If strSelected = ActiveWorkbook.Sheets(N).Name Then
ComboBox1.ListIndex = N - 1
End If
Next N
End Sub
Very nice solution Peter.
In my case I have a list of items that can change between two combobox runs. If the selected combobox item is not anymore in the combo list, at the next run, the line:
ComboBox1.Value = strValue
throws an error .
I've found that declaring a public index:
Public nr As Integer
and making a count inside the combobox code in order to run .clear only once per button action makes this working independently of the list update:
Private Sub ComboBox1_DropButtonClick()
Dim n As Integer
If nr = 0 Then
ActiveSheet.ComboBox1.Clear
nr = 1
Else
nr = 0
End If
For n = 1 To ActiveWorkbook.Sheets.count - 1
ComboBox1.AddItem ActiveWorkbook.Sheets(n).Name
Next n
End Sub

Resources