Remove Duplicates between two Dynamic Listboxes

J

JustLukas

New member
Joined
Jun 10, 2014
Messages
10
Reaction score
0
Points
0
First time here, so big hi everyone!

I've been pulling my hair for hours and was wondering if anyone can help me before i get bald :D

Im trying to remove all items from listbox1 that are in listbox2. All the code is working find until it needs to remove the item in an arry. Thats the part where im getting an invalid argument error. Can someone please help me with this?

Code: 
Private Sub CompareListboxes(lsb1 As MSForms.ListBox, lsb2 As MSForms.ListBox)


Dim i As Long
Dim x As Integer, Tabl()


    ReDim Tabl(0)


    For i = 0 To lsb1.ListCount - 1
         x = x + 1
        ReDim Preserve Tabl(x)
        Tabl(x) = lsb1.List(i)
    Next i
    For i = 0 To lsb2.ListCount - 1
        If IsNumeric(Application.Match(lsb2.List(i), Tabl, 0)) Then
            lsb1.RemoveItem lsb2.List(i) ' <----- Error here
        End If
    Next i
End Sub
 
You delete by index not value, and you have to work up the list not down, else the pointer screws up.

Code: 
Private Sub CompareListboxes(lsb1 As MSForms.ListBox, lsb2 As MSForms.ListBox)Dim Tabl As Variant
Dim x As Long
Dim i As Long


    Tabl = Application.Transpose(lsb1.List)
    
    For i = lsb2.ListCount - 1 To 0 Step -1
    
        x = 0
        On Error Resume Next
        x = Application.Match(lsb2.List(i), Tabl, 0)
        On Error GoTo 0
        If x > 0 Then lsb1.RemoveItem x - 1
    Next i
End Sub
 
Ahh! I see what you mean! The code seems good, it just gives a type mismatch for Tabl and i couldnt find a workable type. Can you help me with that please?
 
I think that is just a forum issue concatenating lines

Code: 
Private Sub CompareListboxes(lsb1 As MSForms.ListBox, lsb2 As MSForms.ListBox)
Dim Tabl As Variant
Dim x As Long
Dim i As Long

    Tabl = Application.Transpose(lsb1.List)
    
    For i = lsb2.ListCount - 1 To 0 Step -1
    
        x = 0
        On Error Resume Next
        x = Application.Match(lsb2.List(i), Tabl, 0)
        On Error GoTo 0
        If x > 0 Then lsb1.RemoveItem x - 1
    Next i
End Sub
 
No no, i fixed the declaration. Its in the formula itself i think
 
There is no formula, it is code. What line throws the error?
 
I meant code... It gives a Type mismatch error in

Tabl = Application.Transpose(lsb1.List)
 
Worked for me. Can you post the workbook?
 
Sure. The code is located in the TextBoxChange module. It is mainly working with many dynamic multipages and textboxes + listboxes. Let me know if i can clarify anyhting.

File: View attachment Cost DB.xlsm

Edit: Forgot to mention, the textbox is located when running the macro in Filters>All Filters> Any of the filters text box ( first need to place at least 1 to the filters from 1 listbox to the other for the textbox to work)
 
Last edited:
I don't want to spend my time wading through all of your code to try and figure out what gets called where, just tell me what I need to click/enter/do to test this function.
 
Please Press Filter control button on the "Main Controls" sheet>then go to Filters Tab> All Filters> and in the text box there enter anything and the error will come up

Edit: The point that i want to achieve is that when there is something in the right list box and it tries to filter in the left list box, it would just filter the ones out that already exist in the right
 
Last edited:
Code: 
Sub M_snb()
    sn = lsb1.List
    sp = lsb2.List
    
    For j = 0 To UBound(sn)
      If IsError(Application.Match(sn(j, 1), sp, 0)) Then c00 = c00 & "_" & j + 1
    Next
    
    lsb1.List = Application.Index(sn, Split(Mid(c00, 2), "_"), 0)
End Sub
 
I modified it a bit and it works! Thanks Snb! Interesting way of doing it!
 
You must log in or register to reply here.
Back
Top