Combobox, maar wil geen dubbele waarde zien

[HWV]

Beste,

Ik gebruik bij het laden van mijn userform onderstaande stuk code om de gegevens te laden in de combobox "Grouppage"

Dim c As Range
Grouppage.Clear
With Worksheets("Database")
    For Each c In .Range(.Range("AX3"), .Range("AX" & .Rows.Count).End(xlUp))
        If c.Value <> vbNullString Then Grouppage.AddItem c.Value
    Next c
End With

De lege cellen slaat hij al over, maar zou ook enkel alleen de unieke waarde willen zien dus zonder de de dubbele waarde.

Ik krijg het nog niet voor elkaar, en zou graag wat ondersteuning willen krijgen hierin.


Alvast dank

Henk

 

[VenA]

ar = Sheets("Database").Range("AX3: AX" & Sheets("Database").Cells(Rows.Count, 50).End(xlUp).Row)
  Set d = CreateObject("Scripting.Dictionary")
  For j = 1 To UBound(ar)
    If ar(j, 1) <> "" Then d(ar(j, 1)) = ""
  Next j
  Grouppage.List = d.keys

 

[HWV]

Beste VenA,

Dank maar weer voor je reactie.

Ik heb deze getest en voldoet aan wat ik gevraagd had. Enkel wil het ook gesorteerd hebben.
Tijdens mijn zoektocht kwam ik de code tegen van SNB, en die sorteert, ontdubbeld en laat de lege cellen niet zien.

sn = Sheets("DataBase").Range("AX3:AX10000")
With CreateObject("System.Collections.ArrayList")
For Each cl In sn
If cl <> "" And Not .contains(cl) Then .Add cl
Next
 .Sort
 Grouppage.List = Application.Transpose(.toarray())
 End With

Voor nu voldoet deze code zeker wat ik voor ogen had.
Dank nogmaals voor je inzet die erg gewaardeerd wordt.

Henk

 

[HSV]

Transpose is niet nodig.

Geen idee wat er in het bereik staat, maar met die methode is a<>A en z<>Z (dus hoofdletter gevoelig).
Ik zou er dus een LCase aan toevoegen.

sn = Sheets("DataBase").Range("AX3", sheets("database").cells(rows.count, 50).end(xlup))
With CreateObject("System.Collections.ArrayList")
For Each cl In sn
If cl <> "" And Not .contains([COLOR=#ff0000]lcase(cl)[/COLOR]) Then .Add cl
Next
 .Sort
 Grouppage.List = [COLOR=#ff0000].toarray[/COLOR]
 End With

En misschien nog een Trim functie.

 

[VenA]

Met het geavanceerde filter zou ook kunnen. Bij gebrek aan een voorbeeldbestand krijg je dan zoiets.

Private Sub UserForm_Initialize()
  With Sheets("Database")
    .Range("AX3: AX" & .Cells(Rows.Count, 50).End(xlUp).Row).AdvancedFilter xlFilterCopy, , .Range("BB1"), True
    With .Columns("BB")
      .Sort .Cells(1)
      Grouppage.List = .SpecialCells(2).Value
      .Delete
    End With
  End With
End Sub

 

[HWV]

Beste,

Dank voor de optie`s die zijn aangedragen.
Ik ga ermee aan de slag.

Groet Henk

 

[snb]

@HSV

In Dictionaries gebruiken we daarvoor de eigenschap comparemode.

Met Advancedfilter:

Private Sub UserForm_Initialize()
   With Sheets("Database")
    .columns(50).AdvancedFilter 2, , .cells(1,55), -1
    With .Columns(55)
      .Sort .Cells(1)
      Grouppage.List = .SpecialCells(2).offset(2).specialcells(2).Value
      .clearcontents
    End With
  End With
End Sub

 

[HSV]

@snb, wat jij doet moet jij weten.

Ik ken de methode.

 = vbtextcompare

De Lcase is korter.