I want to have 2 listboxes, 1 with a bunch of values and one with another bunch of values, I want to add them to a 3rd listbox and then delete all of the matching values,
here is my code i have got so far,
For i = 0 To (ListBox1.ListCount - 1)
ListBox3.AddItem (ListBox1.List(i))
Next
Dim qstring As String
For i = 0 To (ListBox2.ListCount - 1)
qstring = ListBox1.List(i)
With Me.ListBox3
'Loop through combobox
For b = 0 To .ListCount - 1
If .List(b) = qstring Then
strFound = True
Exit For
End If
Next b
'Check if we should add item
If Not strFound Then .AddItem (qstring)
End With
Next
Revised, Thank you for your help sir, I am now wondering why I am receiving this error, Thank you!
Error
You can use a Scripting.Dictionary object which allows unique Keys. You can check if an item exist using the .Exists method.
Sub Whatever()
Dim obj As Object
Set obj = CreateObject("Scripting.Dictionary")
'1st ListBox
For i = 0 To ListBox1.ListCount - 1
If Not obj.Exists(CStr(ListBox1.List(i))) Then
obj.Add CStr(ListBox1.List(i)), vbNullString
End If
Next
'2nd ListBox
For i = 0 To ListBox2.ListCount - 1
If Not obj.Exists(CStr(ListBox2.List(i))) Then
obj.Add ListBox2.List(i), vbNullString
End If
Next
'add unique list to 3rd ListBox
Dim Key As Variant
For Each Key In obj.Keys
ListBox3.AddItem Key
Next Key
End Sub
Edit:
Credit to #Nathan_Sav for pointing this out. No need to loop to fill the 3rd ListBox.
ListBox3.List = obj.Keys()
Related
How do I get the item name on listbox?
I have this code:
Dim x2 As Long
Dim OriginalCount2 As Long
'Store original ListBox count
OriginalCount2 = ListBox1.ListCount
'Temporarily hide ListBox (runs faster)
ListBox1.Visible = False
'Delete selected line items
For x2 = OriginalCount2 - 1 To 0 Step -1
If ListBox1.Selected(x2) = True Then MsgBox x2
Next x2
'Unhide ListBox
ListBox1.Visible = True
But it only gets the item index.
Would help to know what is event or action is triggering the code but this should get you started in the right direction:
Private Sub ListBox1_Click()
Dim LBItem As Long
For LBItem = 0 To ListBox1.ListCount - 1
If ListBox1.Selected(LBItem) = True Then
MsgBox (ListBox1.List(LBItem))
End If
Next
End Sub
I am writing vba code that will search all listbox items against a entire column in a sheet.
If listbox item not found in Excel sheet column, i want to delete the item from list. I tried few codes, its showing some error as "Could not get list property, Invalid property array index". Below is my code i am using currently.
Private Sub CommandButton1_Click()
Dim itemExistResults As Boolean
Dim myarray()
Dim intItem As Long
myarray = Application.Transpose(Sheet1.Range("a2:a1000"))
For intItem = 0 To ListBox1.ListCount - 1
If IsInArray(ListBox1.List(intItem), myarray) Then
Else
ListBox1.RemoveItem intItem
End If
Next
End Sub
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = UBound(Filter(arr, stringToBeFound)) > -1
End Function
Any idea where i am wrong in this code.
You should iterate from the last item of list to the first, because removing items changes their indexation.
Try to change your loop like that:
For intItem = ListBox1.ListCount - 1 To 0 Step -1
If IsInArray(ListBox1.List(intItem), myarray) Then
Else
ListBox1.RemoveItem intItem
End If
Next
I have a tip for you connected with your task, but not exactly with the error described in question.
For this type of task you should use object of Dictionary type instead of iterating through array - it would be much more effective.
I have modified your code to use dictionary. Check it and compare the time each of those solutions need to complete this task - the one with dictionary should be much faster. If you have any questions regarding this code, let me know in comments.
Private Sub CommandButton1_Click()
Dim myArray As Variant
Dim intItem As Long
Dim dict As Object
Dim i As Long
Dim value As Variant
'--- [Loading data into dictionary] ------------------------------------
Set dict = VBA.CreateObject("Scripting.Dictionary")
myArray = Sheet1.Range("A2:A1000")
'Iterate through all the items in array and load them into dictionary.
For i = LBound(myArray) To UBound(myArray)
value = myArray(i, 1)
If Not IsEmpty(value) Then
If Not dict.exists(value) Then
Call dict.Add(value, 0)
End If
End If
Next i
'-----------------------------------------------------------------------
'--- [Comparing ListBox with dictionary] -------------------------------
With ListBox1
For intItem = .ListCount - 1 To 0 Step -1
value = .List(intItem)
If Not dict.exists(value) Then
.RemoveItem intItem
End If
Next
End With
'-----------------------------------------------------------------------
End Sub
I've worked with userforms in VBA a bit and know some of the tricks for looping through all controls. However, I'm running into issues with this one, and need a way to read the values of the line and reason columns into arrays based upon the values of "Area" and "Shift". The possible values for these two columns are in the picture.
Basically what I need is something like
For Each ctl In Me.Controls
If somectl.Value = "Kitting" And otherctl.Value = "1" Then
ReDim Preserve somearray(i)
somearray(i) = ctl.Value
End If
Next ctl
If you've manage to standardized your naming, you can do it like this:
Private Sub CommandButton1_Click()
Dim i As Integer
Dim areaCB As MSForms.ComboBox
Dim shiftCB As MSForms.ComboBox
Dim reasonCB As MSForms.ComboBox
Dim somearray
For i = 1 To 3 ' 3 or more depending on how may you have in your form
Set areaCB = Me.Controls("areadd" & i)
Set shiftCB = Me.Controls("shiftdd" & i)
Set reasonCB = Me.Controls("reasondd" & i)
If areaCB.Value = "Kitting" _
And shiftCB.Value = "1" Then
If IsArray(somearray) Then
ReDim Preserve somearray(UBound(somearray) + 1)
somearray(UBound(somearray)) = reasonCB.Value
Else
somearray = Array(reasonCB.Value)
End If
End If
Next
End Sub
So for example in areadd1, 1 is the row number.
Correspondingly, the ComboBox next to it to the right is shiftdd1 and so on.
This is just to give you idea. Modify it to suit your needs.
The below code should search DataGridView1 which is on the LeaderAccessTable form for an integer that the user inputs into SendFromID, if the DataGridView1's first column contains what the integer that the user has entered into SendFromID then the entire row should be selected. However it doesn't select any rows at all... Can anyone see why? This code is ran from a separate form.
Dim intcount As Integer
For Each Row As DataGridViewRow In LeadersAccessTable.DataGridView1.Rows
If LeadersAccessTable.DataGridView1.Rows(intcount).Cells(0).Value.ToString = SendFromID.Text Then
LeadersAccessTable.DataGridView1.Rows(intcount).Selected = True
End If
Next
MsgBox("Done.")
In the end this code worked.
Dim v_SelectRow As Integer
For counter = 0 To (LeadersAccessTable.DataGridView1.Rows.Count - 1)
For counter2 = 0 To (LeadersAccessTable.DataGridView1.Columns.Count - 1)
If (LeadersAccessTable.DataGridView1.Rows(counter).Cells(0).Value.ToString.Contains(SendFromID.Text)) Then
LeadersAccessTable.DataGridView1.Rows(counter).Cells(0).Selected = True
v_SelectRow = LeadersAccessTable.DataGridView1.CurrentRow.Index
CurrentPoints.Text = LeadersAccessTable.DataGridView1.Item(8, v_SelectRow).Value
'Do Something
Else
'Do Something
End If
Next
Next
I have been working with VBA in excel and recently began working with the Scripting.Dictionary object. I hadn't run across any major problems until today.
Basically I am trying to populate a listbox with the Key values of a dictionary, then add one more value to the listbox. This results in the value not only being added to the listbox, but also to the dictionary as a key. I have attempted to copy the values from the dict.keys() array to a completely separate array, but still have the same issue. I assume this is a byref problem but have yet to figure out a solution. If anyone has any ideas that would be awesome.
Private Sub Setup_settingLst()
'Set Settings listbox items
'On Error GoTo ErrorExit
Dim list_ary() As Variant
Dim tmp As Variant
Dim i As Integer
settingLst.Clear
settingLst.Value = "-Select Setting-"
i = 0
tmp = tmp_dict.Keys()
If tmp_dict.Count > 1 Then
ReDim list_ary(0 To tmp_dict.Count)
For i = 0 To UBound(tmp)
list_ary(i) = tmp(i)
Next i
list_ary(tmp_dict.Count) = "Back"
Else
ReDim list_ary(0 To tmp_dict.Count - 1)
For i = 0 To UBound(tmp)
list_ary(i) = tmp(i)
Next i
End If
settingLst.List = list_ary
Erase list_ary
Exit Sub
ErrorExit:
End Sub
This seems to work
Private Sub UserForm_Click()
Dim dcValues As Scripting.Dictionary
Me.ListBox1.Clear
Set dcValues = FillDictionary
Me.ListBox1.List = dcValues.Keys
Me.ListBox1.AddItem "Back"
End Sub