Remove duplicates in Listbox

[Bruno74]

Hello to all.

I know that there are lots of info on this but i can´t put it to work, so i ask for help

I created a Lisbox1 that populates when i click the search button.
Have a Dynamic range for populating ( Workbook \ Formulas \ Name Manager - =OFFSET(Sheet1!$A$2;0;0;COUNTA(Sheet1!$A:$A)-1;10) )
And this code in the button: ( ListBox1.RowSource = "test" )


It populates with 10 lines. 5 lines the name Mike and 5 lines the name John.
I would like to populate with (in this case) 2 lines. One for Mike and other for John.
I would like do populate only with unique names. Remove the duplicates.

I search and found lots of code for this, but it doesn´t seem to work for me.
Am i putting the code in the wrong place? Do i have to change something?


Example of code i found for removing duplicates:




Sub Sample()
RemovelstDuplicates ctrlListNames
End Sub




Public Sub RemovelstDuplicates(lst As msforms.ListBox)
Dim i As Long, j As Long
With lst
For i = 0 To .ListCount - 1
For j = .ListCount - 1 To (i + 1) Step -1
If .List(j) = .List(i) Then
.RemoveItem j
End If
Next
Next
End With
End Sub


Tks!

 

[Kenneth Hobson]

Did you get the part where you can not have both RowSource and List?

I am not sure why you need the dynamic range Test. That can be set in code. In any case, you can reference it in code if it was set right doing it this way in the Userform code.

Private Sub UserForm_Initialize()
  Dim r As Range
  
  'Set r = Worksheets("Sheet1").Range("B2", _
    Worksheets("Sheet1").Cells(Rows.Count, "B").End(xlUp))
  Set r = Worksheets("Sheet1").Range("Test")
  
  ListBox1.RowSource = "" 'Can not use both RowSource and List
  ListBox1.List = UniqueArrayByDict(r.Value)
End Sub

Private Sub CommandButton1_Click()
  ListBox1.AddItem "a"
End Sub

Private Sub CommandButton2_Click()
  ListBox1.List = UniqueArrayByDict(ListBox1.List)
End Sub

The code below is put into a Module. Button1 above is to show how a duplicate was added the Listbox1's unique list of a and b. Button 2 shows how to again remove duplicates.

'Early Binding method requires Reference: MicroSoft Scripting Runtime, scrrun.dll
Function UniqueArrayByDict(Array1d As Variant, Optional compareMethod As Integer = 0) As Variant
  Dim dic As Object 'Late Binding method - Requires no Reference
  Set dic = CreateObject("Scripting.Dictionary")  'Late or Early Binding method
  'Dim dic As Dictionary     'Early Binding method
  'Set dic = New Dictionary  'Early Binding Method
  Dim e As Variant
  dic.CompareMode = compareMethod
  'BinaryCompare=0
  'TextCompare=1
  'DatabaseCompare=2
  For Each e In Array1d
    If Not dic.Exists(e) Then dic.Add e, Nothing
  Next e
  UniqueArrayByDict = dic.Keys
End Function

 

[Bruno74]

Still didn´t give up on having this done.

Here goes all:


1 Form (Userform1)
1 Textbox (TextBox1) - User input
1 Button (Button1) -- Searches in Collun "C". Populates ListBox. Copies to Sheet2 all matches
1 List box( ListBox1) -- Should show only unique names
1 xls with 2 Sheets ( Sheet1 and Sheet2)
(There is a Dynamic range named "test" for populating List Box ( Formulas \ Name Manager --> =OFFSET(Sheet2!$A$2,0,0,COUNTA(Sheet2!$A:$A)-1,10))


Data to search is in Sheet1, collum C
Sheet2 is for the results. After finding it copies the results to Sheet2 (will need this for the future)


The code:
Private Sub Button1_Click()
Dim RowNum As Long
Dim SearchRow As Long


RowNum = 2
SearchRow = 2


Worksheets("Sheet1").Activate


Do Until Cells(RowNum, 1).Value = ""
If InStr(1, Cells(RowNum, 3).Value, TextBox1.Value, vbTextCompare) > 0 Then
Worksheets("Sheet2").Cells(SearchRow, 1).Value = Cells(RowNum, 1).Value
Worksheets("Sheet2").Cells(SearchRow, 2).Value = Cells(RowNum, 2).Value
Worksheets("Sheet2").Cells(SearchRow, 3).Value = Cells(RowNum, 3).Value
Worksheets("Sheet2").Cells(SearchRow, 4).Value = Cells(RowNum, 4).Value
SearchRow = SearchRow + 1
End If


RowNum = RowNum + 1


Loop
ListBox1.RowSource = "test"


End Sub

 

[Bruno74]

Did you get the part where you can not have both RowSource and List? [/CODE]

Yes. I just don´t know how to do it in other way

I need the duplicates in the ListBox to go away and i need the search results to be placed in Sheet2. All of them

 

[Kenneth Hobson]

You were shown how, use List, not RowSource.

I don't know what you mean by search results. An array can be returned from a Range or a List. Sometimes, one needs to Transpose the array.

This shows how one can get the array with duplicates removed. Values are then added in a column on Sheet2, starting at C1.

Private Sub CommandButton2_Click()
  Dim a
  a = UniqueArrayByDict(ListBox1.List)
  ListBox1.List = a
  'Debug.Print lbaound(a), UBound(a)
  Worksheets("Sheet2").Range("C1").Resize(UBound(a) + 1).Value = WorksheetFunction.Transpose(a)
End Sub