Inhoud opvolgende comboboxunieke waarden sorteren

[Figaro75]

Beste VBA specialisten,

Voor een adressenbestand heb ik met het nodige plakwerk aan codes een redelijk werkend geheel gekregen.
Wat mij niet lukt is opvolgende comboboxen gesorteerd te krijgen.
Het bestand waar ik in werk heeft met name in kolom 32 vaak ontbrekende gegevens.
In kolom 24 staan namen maar deze zijn in de originele sheet niet gesorteerd.
De sheet met gegevens wordt alleen op klantnaam gesorteerd.

Dit was mijn eerste poging:

Private Sub keus1_Change()

Dim RRow As Integer
RRow = 2

    keus24.Clear
    keus32.Clear
    
    With Blad2
        Do Until .Cells(RRow, 1) = ""
            If .Cells(RRow, 1) = keus1.Value Then
                keus24.AddItem .Cells(RRow, 24)
                keus32.AddItem .Cells(RRow, 32)
            End If
            RRow = RRow + 1
        Loop
    End With
End Sub

De code die ik hierboven gebruikte vulde netjes de comboboxen 24 en 32 alleen dan kwamen er ook dubbele of lege gegevens in te staan (met name uit kolom 32, afdeling)
Ik heb momenteel de volgende code:

Private Sub keus1_Change()

    keus24.ListIndex = -1
    keus32.ListIndex = -1
    
    [Blad1!A1] = keus1.Value
    If keus1.ListIndex > -1 Then keus24.List = Split(lijst(Filter([transpose(if(gegevens!A3:A999=Blad1!A1,gegevens!X3:X999,"#"))], "#", False)), ",")
    If keus1.ListIndex > -1 Then keus32.List = Split(lijst(Filter([transpose(if(gegevens!A3:A999=Blad1!A1,gegevens!AF3:AF999,"#"))], "#", False)), ",")
  
End Sub

Function lijst(sn)
    For j = 0 To UBound(sn)
        If InStr(c01 & ",", "," & sn(j) & ",") = 0 Then c01 = c01 & "," & sn(j)
    Next
    lijst = Mid(c01, 2)
End Function

Met de bovenstaande code lukt het me om de unieke waarde eruit te krijgen maar deze komen in volgorde van de originele sheet te staan.
Daarnaast komt bij keus32 de lege cel als een 0 erbij te staan. I.p.v. 0 zou een 'lege' keuze mooier zijn.
Dus hoe kan ik de combobox 24 en 32 nog laten sorteren oplopend (dus NIET de sheet!)??

Bekijk bijlage Contacten.xlsm

Ik ben zelf niet bedreven in VBA maar probeer met veel uitproberen met voorbeelden van bv deze site toch het een en ander bij ons te automatiseren.
Dus van veel van de code weet ik niet precies wat het doet of waarom het het doet maar bij ons telt eventjes het resultaat.

Nog een vraagje over de lijst - split functie.

Van wat ik begrijp worden alle gevonden waarde eerst in een lijst gezet (alles achter elkaar) met hierin een "," tussen elke gevonden waarde.
Is er een mogelijkheid dat hij hiervoor bv "|" gebruikt en dat hij hem dan ook splitst bij de "|".
Bij de keus1_Change is dat de "," denk ik maar moet ik dan in de lijst functie ook elke "," vervangen door een "|"?
Dit omdat ik eerst gebruik maakte van achternaam, tussenvoegsel en initialen maar dan splitste hij die ook (kolom 26)
Ik gebruik nu kolom 24 om dit even te voorkomen (en op voornaam leest misschien wat makkelijker voor de gebruikers).

 

[HSV]

Test het zo eens.
Misschien is het handiger als je ook nog een splitsing maakt tussen 32 en 24 (afdeling en contacten)
Bv. Je kiest voor 'administratie' , dan kun je alleen maar kiezen uit die groep, en krijg je niemand in je contactenlijst van 'Aankoop'.

 

[Figaro75]

Harry,

Dat werkt perfect, mijn dank is groot. :thumb::thumb:

Voor dit userform is dat niet echt nodig want hiermee worden nieuwe klanten toegevoegd.
Maar als een bepaalde klant al voorkomt met contactpersonen en eventueel afdelingen wil ik dat de combobox de juiste schrijfwijze reeds aangeven. Zo hoop ik dat ik niet 1 klant met verschillende schrijfwijze krijg.....
Tevens kunnen mensen zo de bestaande klant naam selecteren en even controleren of ze een contactpersoon niet per ongeluk 2x gaan toevoegen.

Roept meteen een nieuwe uitdaging op....even kijken of ik kan voorkomen dat data wordt toegevoegd als de combo keus1 & keus24 & keus32 al bestaat met een msgbox om de gebruiker hierop te wijzen.....

Voor het oproepen en bewerken (staan niet in dit verkleinde bestand) doe ik dat wel.
'Probleem' is dat de basislijst ("gegevens") al een aantal jaar hap-snap door verschillende mensen is ingevuld.
De afdeling ontbreekt in 95% van alle klanten.

Dus hier laat ik na de klantkeuze eerst de naam selecteren en daarna de afdeling, maar andersom zou wel de beste manier zijn (zo zijn de userforms in volgorde van keuze ook ingericht).

Het mooiste zou zijn dat keus26 gevuld kan worden door keus32 maar ook andersom, dus 32 vullen via 26.
Maar ik verwacht dat ik dat gewoon via keus26_change en keus32_change kan instellen.

PS @Harry
Ik heb nog een klein probleempje, zie ander topic.
Hoe voeg ik automatisch een nieuwe regel toe op basis van een benoemde 'lege' regel ("Leeg") binnen een benoemd bereik ("Contacten") NA het toevoegen of verwijderen van een klant?
Mijn code plaatst hem boven alle reeds ingevoerde klanten......
Ga alvast proberen om ipv in de range ("contacten") maar gewoon in de hele kolom A te laten zoeken

 

[Figaro75]

Een vraagje, werkt dit ook met benoemde bereiken?

         sq(i) = Split(Join(Filter([transpose(if(gegevens!A3:A999=Blad1!A1,gegevens!AF3:Af999,"#"))], "#", False), "|"), "|")

Dus kan je i.p.v.

gegevens!A3:A999

een benoemde range aangeven?

 

[Figaro75]

Blijkbaar wilde ik te moeilijk denken......

Als ik ipv gegevens!A3:A999 meteen de naam van het benoemde bereik gebruik doet hij het gewoon.

 

[Figaro75]

@Harry .... of iemand anders....

Hoe kan ik met het veranderen van keus1 (klant) de onderstaande code zo aanpassen dat er meerdere comboboxen worden gevuld uit verschillende bereiken?

Dus nu vult hij keus26 en 32 maar ik zou graag nog 2 boxen willen vullen met andere bereiken.
Ik heb al geprobeerd de sq(4) en For i = 1 To 4 te zetten en dan gewoon If i = 1 Then, If i = 2 then, etc. maar dat werkt niet....

Huidige code (van Harry):

Private Sub keus1_Change()
Dim sq(2)
    keus24.ListIndex = -1
    keus32.ListIndex = -1
    
 [Blad1!A1] = keus1.Value
     With CreateObject("System.Collections.ArrayList")
     For i = 1 To 2
      If i = 1 Then
         sq(i) = Split(Join(Filter([transpose(if(gegevens!A3:A999=Blad1!A1,gegevens!AF3:Af999,"#"))], "#", False), "|"), "|")
        Else
         sq(i) = Split(Join(Filter([transpose(if(gegevens!A3:A999=Blad1!A1,gegevens!x3:x999,"#"))], "#", False), "|"), "|")
      End If
        For Each cl In sq(i)
          If cl > 0 And Not .contains(cl) Then .Add cl
        Next cl
     .Sort
  If i = 1 Then
    If keus1.ListIndex > -1 Then keus32.List = .toarray
  Else
    If keus1.ListIndex > -1 Then keus24.List = .toarray
  End If
  .Clear
    Next i
  End With
End Sub

 

[HSV]

Helaas kan ik hier vandaan niet zien hoe je het hebben wil.

 

[Figaro75]

Harry,

Ik wil een keus25 (is dus kolom 25 uit het gegevensblad) uit het bereik:

sq(i) = Split(Join(Filter([transpose(if(gegevens!A3:A999=Blad1!A1,gegevens!Y3:Y999,"#"))], "#", False), "|"), "|")

En een keus40 (is dus kolom 40 uit het gegevensblad) uit het bereik:

sq(i) = Split(Join(Filter([transpose(if(gegevens!A3:A999=Blad1!A1,gegevens!AN3:AN999,"#"))], "#", False), "|"), "|")

Dus op basis van hetzelfde bestand wat jij al werkend voor mij had gekregen.

 

[HSV]

Zoiets?

Private Sub keus1_Change()
Dim sq(4)
    keus24.ListIndex = -1
    keus32.ListIndex = -1
    
 [Blad1!A1] = keus1.Value
     With CreateObject("System.Collections.ArrayList")
         sq(1) = Split(Join(Filter([transpose(if(gegevens!A3:A999=Blad1!A1,gegevens!AF3:Af999,"#"))], "#", False), "|"), "|")
         sq(2) = Split(Join(Filter([transpose(if(gegevens!A3:A999=Blad1!A1,gegevens!x3:x999,"#"))], "#", False), "|"), "|")
         sq(3) = Split(Join(Filter([transpose(if(gegevens!A3:A999=Blad1!A1,gegevens!y3:y999,"#"))], "#", False), "|"), "|")
         sq(4) = Split(Join(Filter([transpose(if(gegevens!A3:A999=Blad1!A1,gegevens!an3:an999,"#"))], "#", False), "|"), "|")
    For i = 1 To 4
      For Each cl In sq(i)
          If cl > 0 And Not .contains(cl) Then .Add cl
        Next cl
     .Sort
        Select Case i
            Case 1
                keus32.List = .toarray
            Case 2
                keus24.List = .toarray
            Case 3
                keus25.List = .toarray
            Case 4
                keus40.List = .toarray
        End Select
     .Clear
    Next i
  End With
End Sub

 

[snb]

Private Sub keus1_change()
  [Blad1!A1] = keus1.Value
  
  With CreateObject("System.Collections.ArrayList")
      For j = 1 To 4
        [gegevens!X3:X999].Offset(, Choose(j, 0, 1, 8, 16)).Name = "snb_002"
        
        sn = Filter([transpose(if(gegevens!A3:A999=Blad1!A1,snb_002,"#"))], "#", False)
        For Each it In sn
          If it > 0 And Not .contains(it) Then .Add it
        Next

        .Sort
        Me("keus" & Choose(j, 24, 25, 32, 40)).List = .toarray

        .Clear
      Next
  End With
End Sub

 

[Figaro75]

Bedankt heren voor jullie input.

De code van Harry is heel overzichtelijk en elke stap is goed te volgen.
Die van snb is heel mooi compact en ik snap zelfs wat er gebeurt:thumb:

Mijn dank is groot en weer wat geleerd met VBA.

 

[snb]

Maar om binnen Excel te blijven:

Private Sub keus1_change()
  For j = 1 To 4
    [gegevens!X3:X999].Offset(, Choose(j, 0, 1, 8, 16)).advancedfilter 2, ,Sheets("gegevens").cells(1,200),true

    Sheets("gegevens").cells(1,200).currentregion.offset(1).sort Sheets("gegevens").cells(2,200)

    Me("keus" & Choose(j, 24, 25, 32, 40)).List = Sheets("gegevens").cells(1,200).currentregion.offset(1).specialcells(2)
  next
End Sub