VBA voor smarties: Afhankelijke keuzelijsten (ListBoxen)

Afhankelijke keuzelijsten (ListBoxen)

1. Afhankelijke keuzelijsten

Met afhankelijke lijsten (listboxen) kun je een gebruiker begeleiden bij selectie van gegevens uit een database.
Aan de hand van de gegevens in het voorbeeld komen hier 11 verschillende VBA-methoden aan bod om die keuzelijsten te genereren.

- ADODB
- Dictionary
- Collection
- Array
- Pivottable
- Advanced Filter
- Autofilter
- Evaluate
- TreeView
- ArrayList
- SortedList

Deze methoden worden geïllustreerd aan de hand van een database in het voorbeeldbestand.
De database staat in het verborgen werkblad 'Data' in de vorm van een dynamische tabel (ListObject).
Als illustratie is bij de Treeview dezelfde database als .CSV-bestand beschikbaar.
Bij de Treeview wordt getoond hoe de gegevens uit een CSV-bestand ingelezen kunnen worden in een Userform-control.

Het verborgen hulpwerkblad 'PT" is bedoeld voor die methoden die een tijdelijke opslag van gegevens in een werkblad vergen.
Dit hulpwerkblad bevat bijv. een draaitabel, een criteriagebied en exportgebied voor advanced filter, een exportgebied voor autofilter, etc.

De gegevensverzameling komt uit een Duits forum.
De gegevens hebben betrekking op de personeelsplanning van groepen medewerkers, die ingezet kunnen worden op treinen met een bepaalde standplaats.
De eerste kolom 'Stadt' bepaalt de standplaats, de tweede kolom welke trein 'Zug' vanuit die standplaats vertrekt, welke medewerkersgroepen 'Gruppe' er zijn en welke leden 'Mitglieder' die groep kent.
Omdat verschillende personen dezelfde achternaam kunnen hebben wordt ook de voornaam in de kolom 'Vorname' meegenomen.
De gegevenstabel is gesorteerd op achtereenvolgens kolom 1 t/m 5 : "Stadt", 'Zug', 'Gruppe', 'Mitglieder' en tenslotte 'Vorname'.
Voor de afhankelijke lijsten maken we gebruik van de eerste 3 kolommen; na een keuze in de derde lijst toont de vierde lijst alle medewerkers met voornaam van de geselecteerde groep.

Alle methoden worden geïllustreerd met een Userform.
Indien mogelijk wordt iedere VBA-methode geïllustreerd met

- filter vooraf,
- filter nadat een keuze is gemaakt en
- hoe gebruik gemaakt kan worden van een klassemodule.

Iedere methode heeft een eigen kleur.
Dit gebeurt per VBA-methode in afzonderlijke Userforms.
Elk Userform bevat 4 'Frames': F_01 t/m F_04.
Ieder Frame bevat een ListBox: L_01 t/m L_04.
De MultiSelect-eigenschap van iedere ListBox is 'fmMultiSelelectSingle'.
Als de naam en voornaam uit 2 kolommen in een werkblad worden gelezen heeft de vierde Listbox L_04, als .columncount-eigenschap de waarde 2, zodat beide kolommen in de ListBox zichtbaar zijn.

Het startwerkblad biedt keuzen voor de aanpak (filter vooraf, achteraf of met klasse) en de VBA-methode.
De optieknoppen geven weer welke VBA-methoden aan de optievoorwaarden voldoen.

1.1 Gegevensopzet

Je kunt de van elkaar afhankelijke gegevens vooraf definiëren en vastleggen in een werkblad.
Dan dien je voor iedere mogelijke lijst een kolom met lijstelementen te gebruiken: bijv. in kolom K alle Nederlandse provincies, vervolgens in kolom L t/m X per provincie een lijst met plaatsnamen in die provincie en vervolgens straatnamen per plaats.
Vaak wordt daarbij gebruik gemaakt van benoemde gebieden 'named ranges'.
Dit is vooral praktisch als je geen gebruik maakt van VBA, maar alleen van Excel-formules.
Het belangrijkste nadeel van deze aanpak is de ontbrekende flexibiliteit: categorieën worden niet automatisch aangevuld, gewijzigd of verwijderd.
Als het om veel gegevens en lijsten (zoals in het voorbeeldbestand met 211 verschillende lijsten met 3375 unieke items) gaat is het erg veel werk.

Als je gebruik maakt van een dynamische tabel, gecombineerd met VBA, leidt iedere wijziging in de tabel automatisch tot aangepaste lijsten.
Niet alleen de inhoud van de lijsten maar ook het aantal lijsten kan zo dynamisch aangepast worden.
Het voorbeeldbestand bevat een dynamische tabel in het verborgen werkblad 'Data'.
Wanneer van deze tabel een overzicht van mogelijke lijsten gemaakt zou worden, moeten 211 lijsten gemaakt worden.
Dat kan VBA gemakkelijk doen als de gegevens in een dynamische tabelvorm staan.
Deze pagina illustreert diverse VBA-methoden om die lijsten te genereren.

Alle methodes op deze pagina en in het voorbeeldbestand maken gebruik van de dynamische tabel in Excel.
Je kunt ook met een extern database bestand werken.
In dit geval is een CSV-bestand voor-de-hand-liggend.
Bij de Treeview methode worden 3 methoden geïllustreerd hoe een CSV-bestand als database gebruikt kan worden. 2.9.4 Treeview en CSV-file

1.2 kenmerken van lijsten

sortering

Voor een gebruiker is het prettig gesorteerde keuzelijsten gepresenteerd te krijgen.
Het gebruik van een dynamische tabel maakt het sorteren per tabelkolom (van links naar rechts) eenvoudig.
Als de tabel goed gesorteerd is, hoeft VBA dat bij de filtering niet meer te doen.

unieke elementen

Voor een gebruiker is het ook prettig alleen unieke keuzen voorgeschoteld te krijgen.
Bij de filtering van een lijst zal er ook ontdubbeling moeten plaatsvinden.
Zoals we later zullen zien hebben sommige VBA-methoden een ingebouwde ontdubbelaar, in andere methoden zullen we die zelf moeten inbouwen.

toewijzingsmethode

Deze pagina blijft beperkt tot lijsten in een Userform.
De lijsten worden weergegeven in Listboxes.

Een ListBox kan op 3 wijzen gevuld worden.

- de eigenschap Rowsource

De eigenschap Rowsource vereist gebieden in een werkblad met afzonderlijke keuzelijsten.
Nadelen hiervan zijn de inflexibiliteit en de redundantie van gegevens.

- de methode Additem

Additem is niet bedoeld voor het vullen van een ListBox met hele lijsten en is merkbaar traag.

- de eigenschap .List of .Column

Hiermee kun je een ListBox met 1 opdracht een 1-dimensionele of 2-dimensionele array aan de ListBox toewijzen.
De oorsprong van de array maakt niet uit: een werkblad Range, een Object-eigenschap of een VBA-Array.
De ListBox converteert een 1-dimensionele array automatisch naar een 2-dimensionele array.

Voorbeeld:

Sub M_list()

ListBox1.List=Array("aa","bb","cc")
MsgBox ListBox1.List(2,0)

End Sub

1.3 filterstrategieën

Er zijn twee strategieën om lijsten te produceren.

1. - Voorafgaand aan invoer door de gebruiker kunnen op grond van de basisgegevenstabel alle mogelijke keuzelijsten gemaakt worden en ergens opgeslagen: in het werkgeheugen of in een bestand.
2. - De andere strategie is dat pas ná de keuze door de gebruiker de van die keuze afhankelijke vervolgkeuzelijst wordt gegenereerd.

De eerste strategie leidt ertoe, dat er tijd nodig is voor de produktie van alle mogelijke lijsten voordat de eerste keuze aan de gebruiker wordt voorgelegd, maar vergen de vervolgkeuzen nauwelijks tijd.
De tweede strategie toont de gebruiker de eerste keuze erg snel, maar vergt het genereren van vervolgkeuzen meer tijd.

Niet voor alle VBA-methoden is er een keuze voor beide strategieën.
De pivottable (draaitabel) en de TreeView (boomstruktuur) genereren inherent alle mogelijke keuzen voorafgaand aan de eerste keuze van de gebruiker.
De ADODB-methode, Autofilter en Advancedfilter kunnen pas worden geactiveerd ná een keuze van de gebruiker.
Zij zijn dus aangewezen op de tweede strategie.
In het voorbeeldbestand zijn deze opties te kiezen, waarna duidelijk wordt op welke methoden deze van toepassing zijn.

1.4 De functionaliteit van de code

Wat de code moet doen nadat de gebruiker een keuze heeft gemaakt:

- verwijder de keuzen in de keuzelijsten die erop volgen

- maak de keuzelijsten die erop volgen leeg

- vul de op de gewijzigde keuzelijst volgende lijst met keuzen, afhankelijk van de waarde van de huidige keuzelijst en alle voorafgaande.

- als de eerstvolgende keuzelijst slechts 1 item bevat, selecteer dan dat item, omdat de gebruiker toch geen andere keus heeft.

1.5 Gebeurtenisklasse

Het aantal van elkaar afhankelijke keuzelijsten is in principe onbeperkt.
Om dat flexibel te programmeren kun je gebruik maken van een gebeurtenisklasse.
Daarin kun je de gebeurteniscode opnemen voor als de waarde van een ListBox wijzigt.
Met een klassemodule kun je het aantal keuzelijsten in een Userform uitbreiden/beperken zonder iets aan de VBA-Code te hoeven wijzigen, omdat die zich automatisch aanpast.
Voor alle methodes, behalve de TreeView (boomstruktuur) is een klasseversie als voorbeeld opgenomen.

2.1 ADODB

Met de ADODB VBA-bibliotheek kun je gegevens uit een database filteren.
De ADODB-bibliotheek is een aparte VBA-bibliotheek en kun je gebruiken in alle Office-programma's.
Die bibliotheek maak je actief met de ('late binding') instruktie:

With CreateObject("ADODB.recordset")

end with

De bibliotheek heeft een ingebouwde instructie om van de gefilterde gegevens een lijst met unieke waarden te genereren: 'DISTINCT'.
De bibliotheek heeft een ingebouwde instructie om gefilterde gegevens te sorteren: 'SORT BY'
De sorteerfunktie hebben we in ons geval niet nodig omdat de gegevens in de tabel al gesorteerd zijn.

In de instruktie 'Open' specificeer je in het 2e argument de naam van het te verbinden bestand en wat voor soort bestand dit is:
- een verbinding met een Excelbestand: Provider=Microsoft.ACE.OLEDB.12.0
- met de naam van het huidig geopende bestand: Data Source=" & ThisWorkbook.FullName
- en wat voor soort Excel-bestand: Extended Properties=""Excel 12.0 Xml"

In het eerste argument van de instruktie geef je aan:
- welk(e) veld(en) moet(en) worden gelezen: 'SELECT `Stadt`'
- of alleen unieke veld(en) gewenst zijn: 'SELECT DISTINCT `Stadt`'
- uit welk werkblad (de werkbladnaam, niet de codenaam) met Dollarteken in het bestand: FROM `Data$`
- de voorwaarde om een veld te lezen: 'WHERE .... '

De gefilterde gegevens kun je als Array opvragen met .getrows
Anders dan de naam doet vermoeden krijg je met .Getrows een x aantal kolommen terug.
Gebruik de eigenschap .Column om de kolommen als rijen in de Listbox weer te geven.

With CreateObject("ADODB.recordset")

.Open c00, "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 Xml"""
ListBox1.Column = .Getrows
.Close

End With

2.1.1 ADODB: filter achteraf

De code bevindt zich in Userform 'U_ADODB'

De macromodule bevat:
- Userform_Initialize: gebeurteniscode als het Userform wordt geopend
- L_01_Change: 3 gebeurteniscodes als in een Listbox een keuze wordt gemaakt
- M_List: een gemeenschappelijke macro die door andere macro's wordt gestart

Leegmaken volgende keuzelijsten

De code begint met het leegmaken van alle keuzelijsten die volgen op de aktieve keuzelijst.

For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1
Me("L_0" & j).Clear

Nieuwe keuzelijst genereren

De frames F_01 t/m F_03 hebben in de .Tag eigenschap de overeenkomenee kolomnaam , ingesloten in rechte haken: [Stadt],[Zug] en [Gruppe].
Het vierde Frame F_04 heeft in eigenschap.Tag de n kolomnamen van kolom 4 en 5, geschiden door een komma: [Mitglieder] &", " & [Vorname].
In array sp komt per keuzelijst de SQL voorwaarde te staan.
In de volgende Array sp, komt de gecombineerde SQL-string per keuzelijst te staan.
De variabele c00 is de definitieve SQL-string voor de eerstvolgende keuzelijst.

Een nieuwe instantie van de ADODB.recordset wordt gemaakt.
De methode .Open met de SQL-string en het soort verbinding als argumenten,wordt geaktiverd.
Het filterresultaat wort opgeslagen in de array sp.
De nieuwe ADODB.recordset-instantie wordt gesloten.

sp = Array("WHERE " & F_01.Tag & "='" & L_01 & "'", " AND " & F_02.Tag & "='" & L_02 & "'", " AND " & F_03.Tag & "='" & L_03 & "'")
sp = Array("", sp(0), sp(0) & sp(1), sp(0) & sp(1) & sp(2))
c00 = "Select DISTINCT " & Me("F_0" & y + 1).Tag & " from `Data$` " & sp(y)

With CreateObject("ADODB.recordset")

.Open c00, "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 Xml"""
sp = .getrows
.Close

End With

Nieuwe keuzelijst aan volgende ListBox toewijzen

De array sp met de filtergegevens in kolomvorm wordt toegewezen aan de volgende ListBox met de eigenschap .column.
Daardoor zijn de gegevens als regels per record leesbaar.
Als de vervolgkeuzelijst slechts 1 element bevat, is de bemoeienis van de gebruiker overbodig.
De instruktie Listbox1.Listindex = 0 seleert het eerste en enige element in de vervolgkeuzelijst.

With Me("L_0" & y + 1)

.Column = sp
If .ListCount = 1 Then .ListIndex = 0

End With

De volledige code

Sub M_lijst(y)

If y > 0 Then If Me("L_0" & y).ListIndex = -1 Then Exit Sub

For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1
Me("L_0" & j).Clear

Next

sp = Array("WHERE " & F_01.Tag & "='" & L_01 & "'", " AND " & F_02.Tag & "='" & L_02 & "'", " AND " & F_03.Tag & "='" & L_03 & "'")
c00 = "Select DISTINCT " & Me("F_0" & y + 1).Tag & " from `Data$`" & IIf(y > 0, sp(0), "") & IIf(y > 1, sp(1), "") & IIf(y > 2, sp(2), "")

With CreateObject("ADODB.recordset")

.Open c00, "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 Xml"""
sn = .getrows
.Close

End With

With Me("L_0" & y + 1)

.Column = sn
If .ListCount = 1 Then .ListIndex = 0

End With

End Sub

2.1.1 ADODB: filter vooraf

Deze methode levert geen snelheidswinst op ten opzichte van de filtering achteraf.
Daarom is hiervoor geen Userform opgenomen.

2.1.3 ADODB met gebeurtenisklasse

De code bevindt zich in Userform 'U_ADODB_class' en klassemodule 'C_ADODB'

Voor iedere ListBox in het Userform kun je gebruik maken van een klassemodule, waarin de code staat die bij een bepaalde aktie wordt uitgevoerd.
Daarvoor moet je iedere ListBox toewijzen aan een variabele die een verzameling objecten kan bevatten.
Dat kan bijv. een Array, een Dictionary of een Collection zijn.
In het voorbeeldbestand gebruiken we een Array.

De code in Userform 'U_ADODB_class

Koppel de Listboxen aan de klassemodule

In het declaratiedeel van de macromodule van het Userform wordt ieder element van de Array sc een nieuwe instantie van de klassemodule C_ADODB toegewezen.

Dim sc(2) As New C_ADODB

In de Userform-Initialize-procedure wordt iedere ListBox (L_01, L_02,L_03) toegewezen aan de variabele 'c_list' van de klassemodule.
Een keus in deze ListBoxen moet nl. een nieuwe kezelijst voor de volgende ListBox opleveren.

For j = 0 To UBound(sc)

Set sc(j).c_list = Me("L_0" & j + 1)

Genereer de 1e keuzelijst

De koppeling met de klassemodule bewerkstelligt dat een keuze in zo'n gekoppelde ListBox de code in de klassemodule uitvoert.
Om de keuzelijst voor de eerste keuzelijst te genereren aktiveren we ListBox L_01.

L_01 = True

De volledige code

Dim sc(2) As New C_ADODB

Private Sub UserForm_Initialize()

For j = 0 To UBound(sc)

Set sc(j).c_list = Me("L_0" & j + 1)

Next

L_01 = True

End Sub

De code in klassemodule 'C_ADODB'

In het declaratiedeel wordt de ListBox-gebeurtenis-variabele 'c_list' gedeclareerd.

Public WithEvents c_list As MSForms.ListBox

Voor de gebeurtenis 'Change' van de variabele 'c_list' is een procedure opgenomen.
De Objectvariabele 'c_list' verwijst naar de gekoppelde Listbox in het Userform.
Aan de hand van de naam wordt het nummer (y) van de Listbox bepaald, zodat de volgende afhankelijke ListBoxen leeg kunnen worden gemaakt.

Leegmaken volgende keuzelijsten

Iedere ListBox staat in een Frame.
Het Frame fungeert als 'Parent' voor de Listbox.
De 'Parent' van het Frame is het Userform.
Als we andere controls van het Userform willen aanspreken moet dat via de Parent.Parent eigenschap van de objectvariabele c_list.
De volgende keuzelijsten worden leeggemaakt.

y = Val(Right(c_list.Name, 1)) + (c_list.ListCount = 0)

With c_list.Parent.Parent

For j = y + 1 To 4

.Controls("L_0" & j).ListIndex = -1
.Controls("L_0" & j).Clear

End With

Nieuwe keuzelijst genereren

Stel de SQL-string c00 samen.
De Frames F_01, F_02 en F_03 hebben in de Tag eigenschap de naam van de overeenkomstige kolom, ingebed in rechte haken: [Stadt], [Zug] en [Gruppe].
In array sp komen de huidige waarden van de keuzelijsten te staan.
In de tweede array komen de SQL-waarden voor de nieuwe keuzelijst te staan.

Maak een nieuwe ADODB-instantie.
Het tweede argument van de instructie '.Open' legt de verbinding met het werkblad.
Het eerste argument van de instructie '.Open' – de SQL-string - filtert de gewenste gegevens.
Sla het filterresultaat .getrows op in de array sp.

With c_list.Parent.Parent

sp = Array("WHERE " & .F_01.Tag & "='" & .L_01 & "'", " AND " & .F_02.Tag & "='" & .L_02 & "'", " AND " & .F_03.Tag & "='" & .L_03 & "'")
sp = Array("", sp(0), sp(0) & sp(1), sp(0) & sp(1) & sp(2))
c00 = "Select DISTINCT " & .Controls("F_0" & y + 1).Tag & " from `Data$` " & sp(y)

End With

With CreateObject("ADODB.recordset")

.Open c00, "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 Xml"""
sp = .getrows
.Close

End With

Nieuwe keuzelijst aan volgende ListBox toewijzen

Wijs de Array sp via de eigenschap .column toe aan de volgende keuzelijst.
Selecteer het eerste item van de keuzelijst als die slechts 1 item bevat.

With c_list.Parent.Parent.Controls("L_0" & y + 1)

.Column = sp
If .ListCount = 1 Then .ListIndex = 0

End With

De volledige code

Private Sub c_list_change()

If c_list.ListIndex = -1 Then Exit Sub
y = Val(Right(c_list.Name, 1))

With c_list.Parent.Parent

For j = y + 1 To 4

.Controls("L_0" & j).ListIndex = -1
.Controls("L_0" & j).Clear

Next

sp = Array("WHERE " & .F_01.Tag & "='" & .L_01 & "'", " AND " & .F_02.Tag & "='" & .L_02 & "'", " AND " & .F_03.Tag & "='" & .L_03 & "'")
sp = Array("", sp(0), sp(0) & sp(1), sp(0) & sp(1) & sp(2))
c00 = "Select DISTINCT " & .Controls("F_0" & y + 1).Tag & " from `Data$` " & sp(y)

End With

With CreateObject("ADODB.recordset")

.Open c00, "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0 Xml"""
sp = .getrows
.Close

End With

With c_list.Parent.Parent.Controls("L_0" & y + 1)

.Column = sp
If .ListCount = 1 Then .ListIndex = 0

End With

End Sub

2.2 Dictionary

De Dictionary-bibliotheek is een aparte VBA-bibliotheek en kun je gebruiken in alle Office-programma's.
Die bibliotheek maak je actief met de ('late binding') instruktie:

With CreateObject("scripting.dictionary")

end with

Met de Dictionary kun je een inventarisatie maken van alle unieke items voor de keuzelijsten.
Uit die Dictionary moeten we vervolgens 4 verschillende lijsten met unieke items genereren:
De eerste lijst bevat een lijst van unieke stadsnamen: kolom 1
De tweede lijst bevat een lijst van unieke treinnamen per stad
De derde lijst bevat een lijst van unieke groepsnamen per combinatie van stadsnaam en treinnaam
De vierde lijst bevat een lijst van unieke combinaties van groepsleden met voornaam per combinatie van stadsnaam, treinnaam en groepsnaam.

De dictionary overschrijft automatisch een bestaande sleutel, zodat unieke sleutels overblijven.
Voor het genereren van de keuzelijsten is het praktisch de sleutels per keuzelijst een onderscheidend kenmerk mee te geven.
In dit voorbeeld: de eerste keuzelijst: geen kenmerk, de tweede lijst de tilde (~), de derde keuzelijst de pipeline met de tilde (|~), de vierde lijst het hekje met een tilde (#~).
Het deel van de sleutel vóór de tilde zijn de criteria voor de lijst, het deel ná de tilde het element van de lijst.
In de code wordt alleen gebruik gemaakt van de sleutels in de Dictionary.
Omdat de Dictionary in 2 verschillende macro-procedures voorkomt, is het gebruik van een Private variabele voor de Dictionary noodzakelijk.
Die staat in het declaratiedeel van de codemodule van het Userform.

2.2.2 Dictionary: filter achteraf

De code in Userform 'U_dictionary'

Declareer een Private Object-variabele.

Dim dc

Genereer alle unieke sleutel-waarde combinaties

Maak een nieuwe Dictionary-instantie en wijs die toe aan objectvariabele 'dc'.
Lees de databasegegevens in in variabele sn
Voeg per record 4 sleutels (combinaties van de waarden in kolom 1 t/m 5) toe aan de dictionary

Private Sub UserForm_Initialize()

Set dc = CreateObject("scripting.dictionary")
sn = Sheet2.ListObjects(1).Range

With dc

For j = 2 To UBound(sn)

x0 = .Item(sn(j, 1))
x0 = .Item(sn(j, 1) & "~" & sn(j, 2))
x0 = .Item(sn(j, 1) & sn(j, 2) & "|~" & sn(j, 3))
x0 = .Item(sn(j, 1) & sn(j, 2) & sn(j, 3) & "#~" & sn(j, 4) & ", " & sn(j, 5))

Next

L_01.List = Filter(.keys, "~", 0)

End With

End Sub

Start de gemeenschappelijke macro M_list

De bij ListBox1 horende gebeurteniscode ( Private Sub L_01_Change ) wordt aktief na een keuze in ListBox1.
Het nummer van de keuzelijst wordt als argument doorgegeven.

Private Sub L_01_Change()

M_list 1

End Sub

De code in macro 'M_List'

Als geen keuze wordt gemaakt (=.Listindex=-1): stop de macro

If Me("L_0" & y).ListIndex = -1 Then Exit Sub

Maak alle volgende keuzelijsten leeg

For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1
Me("L_0" & j).Clear

Filter de elementen van de keuzelijst en wijs toe aan de volgende ListBox

De sleutels van een Dictionary worden opgeslagen in een 1-dimensionele Array.
Daarom kunnen ze met de methode 'Filter' gefilterd worden.
Zet een filter in variabele c00.
Het filter bestaat uit alle gemaakte keuzen + het kenmerk voor de volgende keuzelijst.
Filter alle sleutels uit de Dictionary dc.
Stel een lijst samen van alle elementen in de gefilterde sleutels achter de Tilde (~).

c00 = L_01 & L_02 & L_03 & Trim(Mid(" |#",y,1))
Me("L_0" & y + 1).List = Filter(Split(Join(Filter(dc.keys, c00 & "~"), "~"), "~"), c00, 0)

Als de nieuwe keuzelijst slechts 1 element bevat, selecteer het dan:

If .ListCount = 1 Then.ListIndex = 0

De volledige code:

Sub M_list(y)

If Me("L_0" &y).ListIndex = -1 Then Exit Sub

For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1
Me("L_0" & j).Clear

Next

sp = Array("",L_01, L_01 & L_02 & "|", L_01 & L_02 & L_03 & "#")
With Me("L_0" & y + 1)

.List = Filter(Split(Join(Filter(dc.keys, sp(y) & "~"), "~"), "~"), sp(y), 0)
If .ListCount = 1 Then.ListIndex = 0

End With

End Sub

2.2.2 Dictionary: filter vooraf

De code van Userform 'U_dictionary_002'

Deze methode bestaat uit 3 fasen:

- de produktie van alle unieke combinaties van recordwaarden als sleutels van een tijdelijke dictionary
- de produktie van alle mogelijke keuzelijsten als elementen van een 'Private' Dictionary dc.
- de toewijzing van een keuzelijst naar aanleiding van door de gebruiker gemaakte keuzen.

De tijdelijke Dictionary wordt gemaakt met de instruktie:

With CreateObject("scripting.dictionary")

End With

De 'Private' Dictionary wordt gemaakt met:

Dim dc
Set dc = CreateObject("scripting.dictionary")

Genereer een overzicht met unieke sleutel-waarden combinaties

Lees de gegevens van de database in array 'sn'.
Doorloop de Array 'sn' en zet in een 'Local' Dictionary alle unieke sleutel-waarden combinaties: in dit geval 3375.
Omdat de dictionary identieke sleutels overschrijft, bevat de uiteindelijke Dictionary alleen unieke sleutels.

Private Sub UserForm_Initialize()

Set dc = CreateObject("scripting.dictionary")
sn = Sheet2.ListObjects(1).Range

With CreateObject("scripting.dictionary")

For j = 2 To UBound(sn)

x0 = .Item(sn(j, 1))
x0 = .Item(sn(j, 1) & "~" & sn(j, 2))
x0 = .Item(sn(j, 1) & sn(j, 2) & "|~" & sn(j, 3))
x0 = .Item(sn(j, 1) & sn(j, 2) & sn(j, 3) & "#~" & sn(j, 4) & ", " & sn(j, 5))

End With

Genereer alle mogelijke keuzelijsten

Maak de eerste keuzelijst met alle steden in kolom A (Stadt)met een filter ode de sleutels van de local dictionary.
Maak voor ieder element uit deze keuzelijst een keuzelijst met unieke items uit kolom B (Zug).
Maak voor ieder element uit deze laatste keuzelijst een keuzelijst met unieke items uit kolom C (Gruppe).
Maak tenslotte een keuzelijst met gegevens uit kolom D en E (Mitglieder en Vorname).
Deze keuzelijsten worden als Arrays in de private Dictionary 'dc' opgeslagen.
Daarom kan zo'n Dictionary-element direkt toegewezen worden aan een ListBox.

dc("Stadt") = Filter(.keys, "~", 0)
For Each it In dc("Stadt")

dc(it) = Filter(Split(Join(Filter(.keys, it & "~"), "~"), "~"), it, 0)
For Each it1 In dc(it)

dc(it & it1) = Filter(Split(Join(Filter(.keys, it & it1 & "|~"), "~"), "~"), it1, 0)
For Each it2 In dc(it & it1)

dc(it & it1 & it2) = Filter(Split(Join(Filter(.keys, it & it1 & it2 & "#~"), "~"), "~"), it2, 0)

Wijs de eerste keuzelijst toe

Wijs de array in Dictionary-element 'Stadt' via de .List-eigenschap toe aan de ListBox 'L_01'..

L_01.List = dc("Stadt")

De volledige code in Userform_Initialize

Dim dc

Private Sub UserForm_Initialize()

Set dc = CreateObject("scripting.dictionary")
sn = Sheet2.ListObjects(1).Range

With CreateObject("scripting.dictionary")

For j = 2 To UBound(sn)

x0 = .Item(sn(j, 1))
x0 = .Item(sn(j, 1) & "~" & sn(j, 2))
x0 = .Item(sn(j, 1) & sn(j, 2) & "|~" & sn(j, 3))
x0 = .Item(sn(j, 1) & sn(j, 2) & sn(j, 3) & "#~" & sn(j, 4) & ", " & sn(j, 5))

Next

dc("Stadt") = Filter(.keys, "~", 0)
For Each it In dc("Stadt")

dc(it) = Filter(Split(Join(Filter(.keys, it & "~"), "~"), "~"), it, 0)
For Each it1 In dc(it)

dc(it & it1) = Filter(Split(Join(Filter(.keys, it & it1 & "|~"), "~"), "~"), it1, 0)
For Each it2 In dc(it & it1)

dc(it & it1 & it2) = Filter(Split(Join(Filter(.keys, it & it1 & it2 & "#~"), "~"), "~"), it2, 0)

End With

L_01.List = dc("Stadt")

End Sub

Selecteer de keuzelijst voor de volgende ListBox

Een keuze in een keuzelijst aktiveert de gemeenschappelijk macro 'M_List'.
Het nummer van de gewijzigde keuzelijst wordt als argument doorgegeven aan de macro 'M_list'.

Private Sub L_01_Change()

M_list 1

End Sub

De code in macro 'M_list'

Maak de vervolgkeuzelijsten leeg

For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1
Me("L_0" & j).Clear

Selecteer het dictionary-item met de volgende keuzelijst

De huidige keuzen in de eerste 3 ListBoxen (L_01, L_02 en L_03) vormen de sleutel voor de volgende keuzelijst.
De keuzelijst is als Array opgeslagen in de Dictionary 'dc'.
Daarom kan aan de hand van de sleutel het Dictonary–element via de eigenschap .List aan de volgende keuzelijst worden toegewezen.
Als deze ListBox slechts 1 item bevat, wordt dat geselecteerd.

With Me("L_0" & y + 1)

.List = dc(L_01 & L_02 & L_03)
If .ListCount = 1 Then .ListIndex = 0

End With

De volledige code in M_list

Sub M_list(y)

If Me("L_0" & y).ListIndex = -1 Then Exit Sub

For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1
Me("L_0" & j).Clear

Next

With Me("L_0" & y + 1)

.List = dc(L_01 & L_02 & L_03)
If .ListCount = 1 Then .ListIndex = 0

End With

End Sub

2.2.3 Dictionary met gebeurtenisklasse

De code bevindt zich in Userform 'U_dictionary_class' en de klassemodule 'C_dictionary'

Koppeling van Listboxen aan gebeurtenisklasse

Voor iedere ListBox in het Userform kun je gebruik maken van een klassemodule, waarin de code staat die bij een bepaalde aktie wordt uitgevoerd.
Daarvoor moet je iedere ListBox toewijzen aan een Object-variabele die een verzameling kan bevatten.
Dat kan bijv. een Array, een Dictionary of een Collection zijn.
In het voorbeeldbestand gebruiken we een Array.

In het declaratiedeel van de macromodule van het Userform wordt aan een drietal elementen van de Array sc een instantie van de klassemodule C_dictionary toegewezen.

Dim sc(2) As New C_ dictionary

Vervolgens wordt in de Initialize-procedure iedere ListBox (L_01, L_02,L_03) waarin een keuze gemaakt kan worden die een afhankelijke lijst moet opleveren toegewezen aan de variabele 'c_list' van de klassemodule.

For j = 0 To UBound(sc)

Set sc(j).c_list = Me("L_0" & j + 1)

Door de koppeling met de klassemodule aktiveert de keuze in de ListBox de code in de klassemodule.

Inventarisatie van alle unieke sleutel-waarde combinaties

In de Userform_initialize procedure wordt een nieuwe Dictionary-instantie toegewezen aan de Public variabele 'dc'.
Deze variabele is public gedeclareerd opdat die in de Classmodule 'C_dictionary' als object van het Userform kan worden aangeroepen.
In de Dictionary 'dc' komen alle unieke items te staan voor de keuzelijsten.

Set dc = CreateObject("scripting.dictionary")

With dc

For j = 2 To UBound(sn)

x0 = .Item(sn(j, 1))
x0 = .Item(sn(j, 1) & "~" & sn(j, 2))
x0 = .Item(sn(j, 1) & sn(j, 2) & "|~" & sn(j, 3))
x0 = .Item(sn(j, 1) & sn(j, 2) & sn(j, 3) & "#~" & sn(j, 4) & ", " & sn(j, 5))

End With

Aan de eerste ListBox worden de Dictionary-items zonder tilde (~) in de sleutel toegewezen.

L_01.List = Filter(.keys, "~", 0)

Volledige code in 'U_dictionary_class'

Public dc Dim sc(2) As New C_dictionary Private Sub UserForm_Initialize()

For j = 0 To UBound(sc)

Set sc(j).c_list = Me("L_0" & j + 1)

Next

sn = Sheet2.ListObjects(1).DataBodyRange.Resize(, 5)

Set dc = CreateObject("scripting.dictionary")
With dc

For j = 2 To UBound(sn)

x0 = .Item(sn(j, 1))
x0 = .Item(sn(j, 1) & "~" & sn(j, 2))
x0 = .Item(sn(j, 1) & sn(j, 2) & "|~" & sn(j, 3))
x0 = .Item(sn(j, 1) & sn(j, 2) & sn(j, 3) & "#~" & sn(j, 4) & ", " & sn(j, 5))

Next

L_01.List = Filter(.keys, "~", 0)

End With

End Sub

De code in klassemodule 'C_ dictionary'

In het declaratiedeel wordt een object-variabele 'c_list' gedeclareerd, als UserformListBox, die geactiveerd wordt als gebeurteniscode (WithEvents).

Public WithEvents c_list As MSForms.ListBox

Voor de gebeurtenis 'Change' is een procedure opgenomen.
De Objectvariabele 'c_list' verwijst naar de gewijzigde Listbox uit het Userform.
Aan de hand van de naam wordt het nummer (y) van de Listbox bepaald, zodat de volgende afhankelijke ListBoxen leeg kunnen worden gemaakt.

Iedere ListBox staat in een Frame.
Het Frame fungeert als 'Parent' voor de Listbox.
De 'Parent' van het Frame is het Userform.
Als we andere controls van het Userform willen aanspreken moet dat via de Parent.Parent eigenschap van de objectvariabele c_list.
De volgende keuzelijsten worden leeggemaakt.

With c_list.Parent.Parent

For j = y + 1 To 4

.Controls("L_0" & j).ListIndex = -1
.Controls("L_0" & j).Clear

End With

De filtersleutel voor de Dictionary items voor de vervolgkeuzelijst wordt samengesteld op basis van reeds gemaakte keuzen:

c00 = .L_01 & .L_02 & .L_03 & trim(mid(" |#",y,1))

Met de sleutel worden uit de Dictionary 'dc' items gefilterd en toegewezen aan de volgende ListBox.
Het eerste item van de ListBox wordt geselecteerd als de ListBox slechts 1 item bevat.

With .Controls("L_0" & y + 1)

.List = Filter(Split(Join(Filter(.Parent.Parent.dc.keys, c00 & "~"), "~"), "~"), c00, 0)
If .ListCount = 1 Then .ListIndex = 0

End With

2.3 Collection

De Collection maakt deel uit van de standaard VBA-bibliotheek.
Je kunt hem in alle Office-programma's gebruiken.
Met een Collection kun je verzamelingen van elementen maken aan de hand van bepaalde criteria.
Dat kunnen dus ook keuzelijsten zijn.

Je kunt geen Collection toewijzen aan een ListBox.
Je kunt wel afzonderlijke elementen aan een listBox toewijzen via .Additem, maar dat is notoir en merkbaar traag.
Handiger is het de elementen van de Collection in een Array te zetten en vervolgens die Array toe te wijzen aan de ListBox via de eigenschap .List.

Net zoals de Dictionary maakt de Collection gebruik van Items en Keys (sleutels).
Ook de Collection kan alleen unieke sleutels bevatten.
Anders dan de Dictionary overschrijft de Collection een sleutel niet, maar genereert een foutmelding.
Die moeten we zien te ondervangen.

Omdat we de interaktie met de Excel-applicatie tot een minimum willen beperken lezen we de tabelgegevens alleen in de Userform_initialize procedure in.
Omdat we de tabelgegevens pas gebruiken in de gemeenschappelijk macro 'M_list', moeten we de variabele met de tabelgegevens als Private declareren, bovenin de macromodule van het Userform.

2.3.1 Collection: filter achteraf

De code van het Userform 'U_collection'

Lees de databasetabel in in Array 'sn'.
Roep de gemeenschappelijke keuzelijstgeneratormacro 'M_list' aan.
Geef als argument het nummer van de keuzelijst door.

Dim sn Private Sub UserForm_Initialize()

sn = Sheet2.ListObjects(1).DataBodyRange.Resize(,5)

M_list 0

End Sub

De code van macro 'M_list'

Maak alle volgende keuzelijsten leeg

For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1
Me("L_0" & j).Clear

Genereer de volgende keuzelijst

Filter alle databeserecords in Array-variabele 'sn' aan de hand van een criterium.
Het criterium is de combinatie van lijstkeuzes in variabele c00.

c00 = L_01 & L_02 & L_03

Maak een nieuwe collectie.
Doorloop de database.
Zet in Array 'st' welke records uit de database overeenkomen met de waarden in c00.
Als een record overeenkomt zet dan het gegeven van de volgende kolom in een nieuw item van de collectie.

With New Collection

For j = 1 To UBound(sn)

st = Array(True, sn(j, 1) = c00, sn(j, 1) & sn(j, 2) = c00, sn(j, 1) & sn(j, 2) & sn(j, 3) = c00)
If st(y) Then .Add sn(j, y + 1) & IIf(y = 3, ", " & sn(j, y + 2), ""), sn(j, y + 1) & .Count * (y = 3)

End With

Zet alle elementen van de collectie in een 1-dimensionele Array

ReDim sp(.Count - 1) For j = 0 To UBound(sp)

sp(j) = .Item(j + 1)

Wijs de keuzelijst toe aan de volgende ListBox

Wijs de 1-dimensionele Array 'sp' toe aan de volgende keuzelijst.
Selecteer het enige element van de keuzelijst met slechts 1 item.

With Me("L_0" & y + 1)

.List = sp
.ListIndex = .ListCount > 1

End With

2.3.2 Collection: filter vooraf

De code in Userform 'U_collection_002'

In het declaratiedeel van de codemodule is een nieuwe Collection variabele gedeclareerd met de naam 'cl'.
Deze Collection-variabele is nu toegankelijk in alle procedures van het Userform.

Dim cl As New Collection

Inventariseer alle sleutel-waarde combinaties

Lees de databasetabel in in Array 'sn'.
Vang foutmeldingen af als de Collection al een identieke sleutel bevat.

sn = Sheet2.ListObjects(1).DataBodyRange.Resize(,5)
On Error Resume Next

Maak een nieuwe Local Collection.
Loop door alle records van de database.
Stel per record aan de hand van de waarden in de eerste 5 kolommen de elementen van de keuzelijsten samen.
Voeg die toe aan de Collection.
Als een sleutel al bestaat gaat de code naar het volgende record.
Deze Collection bestaat zodoende uit louter unieke elementen voor keuzelijsten.

With New Collection

For j = 1 To UBound(sn)

.Add "~" & sn(j, 1), sn(j, 1)
.Add "|" & sn(j, 1) & "_" & sn(j, 2), sn(j, 1) & sn(j, 2)
.Add "|" & sn(j, 1) & sn(j, 2) & "_" & sn(j, 3), sn(j, 1) & sn(j, 2) & sn(j, 3)
.Add "|" & sn(j, 1) & sn(j, 2) & sn(j, 3) & "_" & sn(j, 4) & ", " & sn(j, 5), sn(j, 1) & sn(j, 2) & sn(j, 3) & sn(j, 4) & sn(j, 5)

End With

Declareer een arrayvariabele 'sp' ter grootte van het aantal elementen van de collection.
Deze arrayvariabele dient als hulpmiddel om alle mogelijke keuzelijsten samen te stellen.
Die worden daarna in Collection 'cl' bewaard.
Wijs aan de arrayvariabele 'sp' alle elementen van de collection toe.

ReDim sp(.Count)
For j = 1 To .Count

sp(j) = .Item(j)

Filter afzonderlijke keuzelijsten en bewaar die in de Collection 'cl'

Filter uit Arrayvariabele 'sp' alle afzonderlijke keuzelijsten en voeg de resulterende array als item toe aan de Private Collection 'cl'.

sq = Filter(sp, "_")
Do

st = Split(sq(0), "_")
cl.Add Split(Join(Filter(sq, st(0) & "_"), ""), st(0) & "_"), Mid(st(0), 2)
sq = Filter(sq, st(0) & "_", 0)

Loop Until UBound(sq) = -1

Wijs de eerste keuzelijst toe

Filter uit de array 'sp' alle items voor de eerste keuzelijst en wijs die toe aan ListBox L_01.

L_01.List = Split(Mid(Join(Filter(sp, "~"), ""), 2), "~")

De volledige code

Private Sub UserForm_Initialize()

sn = Sheet2.ListObjects(1).DataBodyRange.Resize(,5)
On Error Resume Next

With New Collection

For j = 1 To UBound(sn)

Next
On Error GoTo 0

ReDim sp(.Count)
For j = 1 To .Count

sp(j) = .Item(j)

Next

sq = Filter(sp, "_")
Do

st = Split(sq(0), "_")
cl.Add Split(Join(Filter(sq, st(0) & "_"), ""), st(0) & "_"), Mid(st(0), 2)
sq = Filter(sq, st(0) & "_", 0)

Loop Until UBound(sq) = -1

End With

L_01.List = Split(Mid(Join(Filter(sp, "~"), ""), 2), "~")

End Sub

Aktiveer macro 'M_list' na iedere keuze

Een keuze in een keuzelijst aktiveert de gebeurtenisprocedure '_Change'.
Deze start de gemeenschappelijke macro 'M_list'.
Het nummer van de keuzelijst wordt als argument doorgegeven.

Private Sub L_01_Change()

M_list 1

End Sub

De code in macro 'M_list'

Maakt de volgende, afhankelijke keuzelijsten leeg

For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1
Me("L_0" & j).Clear

Wijs het Collectie-item met de keuzelijst toe aan de volgende keuzelijst

Het item in Collection 'cl' met een sleutel die overeenkomt met de gemaakte keuze(s) bevat de gewenste keuzelijst
Wijs deze array toe aan de volgende ListBox
Verwijder het eerste lege item in de keuzelijst
Selekteer het eerste item als de lijst slechts 1 item bevat.

With Me("L_0" & y + 1)

.List = cl(L_01 & L_02 & L_03)
.RemoveItem 0
If .ListCount = 1 Then .ListIndex = 0

End With

De volledige code

Sub M_list(y)

If Me("L_0" & y).ListIndex = -1 Then Exit Sub

For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1
Me("L_0" & j).Clear

Next

With Me("L_0" & y + 1)

.List = cl(L_01 & L_02 & L_03)
.RemoveItem 0
If .ListCount = 1 Then .ListIndex = 0

End With

End Sub

2.3.3 Collection met gebeurtenisklasse

De code bevindt zich in Userform 'U_collection_class' en de klassemodule 'C_collection'

Voor iedere ListBox in het Userform kun je gebruik maken van een klassemodule.
Daarin staat de code die bij een bepaalde aktie wordt uitgevoerd.
Daarvoor moet je iedere ListBox toewijzen aan een aparte instantie van de klassemodule.
Die afzonderlijke instanties bewaar je in een Object-variabele die een verzameling kan bevatten.
Dat kan bijv. een Array, een Dictionary of een Collection zijn.
In het voorbeeldbestand gebruiken we een Array.

De code in Userform 'U_collection_class'

Koppel de Listboxen aan de klassemodule

In het declaratiedeel van de macromodule declareren we array 'sc' met drie elementen.
Aan ieder element in de Array 'sc' wijzen we een nieuwe instantie van de klassemodule 'C_collection' toe.

Dim sc(2) As New C_ collection

Wijs in de Initialize-procedure van het Userform iedere ListBox (L_01, L_02,L_03) toe aan objectvariabele 'c_list' in klassemodule C_collection'.
Door de koppeling met de klassemodule start een keuze in een Listbox de code in de klassemodule 'C_collection'.

For j = 0 To UBound(sc)

Set sc(j).c_list = Me("L_0" & j + 1)

Aktiveer de klassemodule om de eerste keuzelijst te genereren

L_01 = True

De volledige code

Dim sc(2) As New C_collection

Private Sub UserForm_Initialize()

For j = 0 To UBound(sc)

Set sc(j).c_list = Me("L_0" & j + 1)

Next

L_01 = True

End Sub

De code in klassemodule 'C_collection'

Het declaratiedeel bevat de declaratie als UserformListBox van object-variabele 'c_list', die geaktiveerd wordt als gebeurteniscode (WithEvents).

Public WithEvents c_list As MSForms.ListBox

De variabele 'sn' is bedoeld om de databasegegevens in te lezen.
De variabele 'sn' wordt 'Private' gedeclareerd.
Daardoor hoeft de database slechts 1 keer ingelezen te worden en is dan gedurende het hele projekt in de klassemodule beschikbaar. Voor de gebeurtenis 'Change' is een procedure opgenomen.
De Objectvariabele 'c_list' verwijst naar de gewijzigde Listbox uit het Userform.
Aan de hand van de naam wordt het nummer (y) van de Listbox bepaald.

Private Sub c_list_change()

If c_list.ListCount > 0 And c_list.ListIndex = -1 Then Exit Sub

If IsEmpty(sn) Then sn = Sheet2.ListObjects(1).DataBodyRange.Resize(, 5)

y = Val(Right(c_list.Name, 1)) + (c_list.ListCount = 0)

Leegmaken vervolgkeuzelijsten

Iedere ListBox staat in een Frame.
Het Frame fungeert als 'Parent' voor de Listbox.
De 'Parent' van het Frame is het Userform.
Als we andere controls van het Userform willen aanspreken moet dat via de Parent.Parent eigenschap van de objectvariabele c_list.
De volgende, afhankelijke, keuzelijsten worden leeggemaakt.

With c_list.Parent.Parent

For j = y + 1 To 4

.Controls("L_0" & j).ListIndex = -1
.Controls("L_0" & j).Clear

End With

Genereer keuzelijst

De zoeksleutel voor de Collection items voor de vervolgkeuzelijst wordt samengesteld op basis van reeds gemaakte keuzen:

c00 = .L_01 & .L_02 & .L_03

Alle records van de database worden doorlopen en gecontroleerd of ze overeenstemmen met de zoeksleutel c00.
Als dat het geval is, wordt het eerstvolgende 'veld'/kolom aan de collectie toegevoegd.
Een bestaande sleutel genereert een foutmelding; foutmeldingen worden genegeerd, de resulterende Collection bevat louter unieke waarden.

With New Collection

On Error Resume Next
For j = 1 To UBound(sn)

st = Array(True, sn(j, 1) = c00, sn(j, 1) & sn(j, 2) = c00, sn(j, 1) & sn(j, 2) & sn(j, 3) = c00)
If st(y) Then .Add sn(j, y + 1) & IIf(y = 3, ", " & sn(j, y + 2), ""), c00 & "_" & sn(j, y + 1)

Next
On Error GoTo 0

Een Collection kan niet worgen toegewezen aan een ListBox.
De Collection-items worden eerst ingelezen in een 1-dimensionele Array 'sp'.

ReDim sp(.Count - 1)
For j = 0 To UBound(sp)

sp(j) = .Item(j + 1)

Toewijzen keuzelijst aan volgende ListBox

De arrayvariabele 'sp' wordt toegewezen aan de volgende keuzelijst in het Userform.
Als deze keuzelijst slechts 1 item bevat, wordt dat item geselecteerd.

With .Controls("L_0" & y + 1)

.List = sp
If .ListCount = 1 Then .ListIndex = 0

End With

De volledige code

Public WithEvents c_list As MSForms.ListBox
Dim sn

Private Sub c_list_change()

If c_list.ListCount > 0 And c_list.ListIndex = -1 Then Exit Sub

If IsEmpty(sn) Then sn = Sheet2.ListObjects(1).DataBodyRange.Resize(, 5)

y = Val(Right(c_list.Name, 1)) + (c_list.ListCount = 0)

With c_list.Parent.Parent

For j = y + 1 To 4

.Controls("L_0" & j).ListIndex = -1
.Controls("L_0" & j).Clear

Next

c00 = .L_01 & .L_02 & .L_03
With New Collection

On Error Resume Next
For j = 1 To UBound(sn)

st = Array(True, sn(j, 1) = c00, sn(j, 1) & sn(j, 2) = c00, sn(j, 1) & sn(j, 2) & sn(j, 3) = c00)
If st(y) Then .Add sn(j, y + 1) & IIf(y = 3, ", " & sn(j, y + 2), ""), c00 & "_" & sn(j, y + 1)

Next
On Error GoTo 0

ReDim sp(.Count - 1)
For j = 0 To UBound(sp)

sp(j) = .Item(j + 1)

End With

With .Controls("L_0" & y + 1)

.List = sp
If .ListCount = 1 Then .ListIndex = 0

End With

End Sub

2.4 Array

Arrays maken deel uit van de standaard VBA-bibliotheek.
Je kunt ze in alle Office-programma's gebruiken.
Arrays hebben geen ingebouwd mechaniek (bijv. via sleutels) om op uniciteit te testen.
Zo'n toets moet je zelf inbouwen.
In dit geval maak ik gebruik van een string waarin alle unieke elementen voorkomen.

2.4.1 Array: filter achteraf

De code in Userform 'U_array'

De databasegegevens lezen we in de Userform_initialize procedure in in de Array-variabele 'sn'.
Daarmee beperken we de interaktie met het werkboek.
De gegevens in variabele 'sn' gebruiker we in de procedure 'M_list'.
Daarvoor moet de variabele 'sn' als Private gedeclareerd worden in het declaratiedeel van de Userform macromodule.
Vervolgens roep je de gemeenschappelijke keuzelijstgeneratormacro 'M_list' aan.
Geef een nummer als argument om aan te geven om welke keuzelijst het gaat.

Dim sn

Private Sub UserForm_Initialize()

sn = Sheet2.ListObjects(1).DataBodyRange.Resize(,5)

M_list 0

End Sub

Keuze in keuzelijst

Start de gemeenschappelijke macro 'M_list' bij een keuze in de keuzelijst.

Private Sub L_01_Change()

M_list 1

End Sub

De gemeenschappelijke macro 'M_list'

Leegmaken volgende keuzelijsten

For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1
Me("L_0" & j).Clear

Genereer de keuzelijst

Zet de combinatie van lijstkeuzes in variabele c00

c00 = L_01 & L_02 & L_03

Loop door de gegevens van de database.
Check of de gegevens van de database overeenkomen met de keuzen in de keuzelijsten.
Check of de waarde van de volgende kolom in de string met unieke waarden voor de volgend keuzelijst ontbreekt.
Als beide checks waar zijn, voeg dan de waarde van de volgende kolom toe aan de string met unieke waarden.
Als de string met unieke waarden is gevuld en de recordgegevens niet meer overeenstemmen met de combinatie van lijstkeuzes, stop dan het zoeken.

For j = 1 To UBound(sn)

c02 = "|" & sn(j, y + 1) & IIf(y = 3, ", " & sn(j, y + 2), "")
st = Array(True, sn(j, 1) = c00, sn(j, 1) & sn(j, 2) = c00, sn(j, 1) & sn(j, 2) & sn(j, 3) = c00, InStr(c01 & "|", c02 & "|") = 0)
If st(y) * st(4) Then c01 = c01 & c02
If Not st(y) And c01 <> "" Then Exit For

Keuzelijst toewijzen aan volgende ListBox

Splits de string met unieke waarden tot een 1-dimensionele Array en wijs die toe aan de volgende keuzelijst.
Selekteer het enige element van de keuzelijst als deze slechts 1 item bevat.

With Me("L_0" & y + 1)

.List = Split(Mid(c01, 2),"|")
If .ListCount = 1 Then .ListIndex = 0

End With

De volledige code

Sub M_list(y)

If y > 0 Then If Me("L_0" & y).ListIndex = -1 Then Exit Sub

For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1
Me("L_0" & j).Clear

Next

c00 = L_01 & L_02 & L_03

For j = 1 To UBound(sn)

Next

With Me("L_0" & y + 1)

.List = Split(Mid(c01, 2), "|")
If .ListCount = 1 Then .ListIndex = 0

End With

End Sub

2.4.2 Array: filter vooraf

De code in Userform 'U_array_002'

De samenstelling van alle keuzelijsten vóórdat de gebruiker een keuze maakt, betekent dat die keuzelijsten in de gebeurtenisprocedure Userform_Initialize gemaakt moeten worden.
Dan moeten die gegenereerde keuzelijsten ook in de procedure, nadat een keuze is gemaakt, toegankelijk zijn.
Declareer daartoe 1 Array-variabele 'sp' in het declaratiedeel van het Userform.
In array-variabele 'sp' komen alle gegenereerde keuzelijsten te staan.
Deze variabele is nu in alle procedures van het Userform toegankelijk.
Zonder nadere specificatie is dit een Variant-variabele.

Dim sp

Lees de database in in Array-variabele 'sn'.

sn = Sheet2.ListObjects(1).DataBodyRange.Resize(, 5)

Genereer unieke sleutel/item-combinaties per keuzelijst

Doorloop variabele 'sn' met de databasegegevens.
Maak Array 'st' met sleutel/element-combinaties voor de 4 keuzelijsten.
Lees per keuzelijst de sleutel/element-combinatie in een aparte 'string'-variabele: c01, c02, c03, c04.
Een sleutel/element-combinatie wordt pas toegevoegd als die niet in de string voorkomt.
De string-variabelen bevatten zo louter unieke waarden.
Een sleutel wordt gemarkeerd door een pipeline (|) vóór en een tilde achter: |sleutel~element
Een element wordt voorafgegaan door de tilde (~).

For j = 1 To UBound(sn)

st = Array("|" & sn(j, 1), "|" & sn(j, 1) & "~" & sn(j, 2), "|" & sn(j, 1) & sn(j, 2) & "~" & sn(j, 3), "|" & sn(j, 1) & sn(j, 2) & sn(j, 3) & "~" & sn(j, 4) & ", " & sn(j, 5))
If InStr(c01, st(0)) = 0 Then c01 = c01 & st(0)
If InStr(c02, st(1)) = 0 Then c02 = c02 & st(1)
If InStr(c03, st(2)) = 0 Then c03 = c03 & st(2)
If InStr(c04, st(3)) = 0 Then c04 = c04 & st(3)

Samenstelling keuzelijsten per sleutel

Uit het totaal van 3375 unieke sleutel/element-combinaties kunnen nu voor de 210 unieke sleutels lijsten met keuzen worden samengesteld.
Per string (c01, c02, c03 en c04) worden de unieke sleutels bepaald.
Per sleutel worden de bijbehorende items uit de elementen van de volgende lijst gefilterd.
Deze worden opgeslagen in stringvariabele c05, gescheiden met #.
De string c05 wordt gesplitst in array-variabele 'sp'.
Array-variabele 'sp' heeft 210 elementen.
Ieder element bevat de sleutel van de keuzelijst en de bijbehorende keuzen.

For j = 1 To 3

st = Split(Replace(Mid(Choose(j, c01, c02, c03), 2), "~", ""), "|")
For Each it In st

c00 = it & "~"
c05 = c05 & "#" & c00 & Replace(Join(Filter(Split(Choose(j, c02, c03, c04), "|"), c00), "|"), c00, "")

Next
sp = Split(c05, "#")

De elementen in c01 voor de eerste keuzelijst worden gesplitst in een array en in keuzelijst L_01 gezet.

De volledige code

Private Sub UserForm_Initialize()

sn = Sheet2.ListObjects(1).DataBodyRange.Resize(, 5)

For j = 1 To UBound(sn)

Next

For j = 1 To 3

st = Split(Replace(Mid(Choose(j, c01, c02, c03), 2), "~", ""), "|")
For Each it In st

c00 = it & "~"
c05 = c05 & "#" & c00 & Replace(Join(Filter(Split(Choose(j, c02, c03, c04), "|"), c00), "|"), c00, "")

Next
sp = Split(c05, "#")

L_01.List = Split(Mid(c01, 2), "|")

End Sub

Een wijziging in een keuzelijst aktiveert de gebeurteniscode _change.
Die roept de gemeenschappelijke macro M_list op en geeft het nummer van de keuzelijst als argument door.

Private Sub L_01_Change()

M_list 1

End Sub

De gemeenschappelijke macro 'M_List'

Leegmaken van volgende keuzelijsten

Alle volgende, afhankelijke, keuzelijsten worden leeggemaakt.

For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1
Me("L_0" & j).Clear

Selekteer de keuzelijst en wijs toe aan de volgende ListBox

De sleutel voor de volgende lijst komt in variabele c00.
De sleutel bestaat uit alle gemaakte keuzen , afgesloten met een ~.
Uit de Array-variabele 'sp' wordt het element met de sleutel gefilterd.
Dit element wordt gesplitst in een Array met alle keuzen.
Die wordt toegewezen aan de volgende keuzelijst.
Als de keuzelijst slechts 1 keuze bevat, wordt die geselecteerd.

c00 = L_01 & L_02 & L_03 & "~" With Me("L_0" & y + 1)

.List = Split(Replace(Filter(sp, c00)(0), c00, ""), "|")
If .ListCount = 1 Then .ListIndex = 0

End With

Volledige code

Sub M_list(y)

If Me("L_0" & y).ListIndex = -1 Then Exit Sub For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1 Me("L_0" & j).Clear

Next c00 = L_01 & L_02 & L_03 & "~" With Me("L_0" & y + 1)

.List = Split(Replace(Filter(sp, c00)(0), c00, ""), "|") If .ListCount = 1 Then .ListIndex = 0

End With

End Sub

2.4.3 Array met gebeurtenisklasse

De code bevindt zich in Userform 'U_array_class' en de klassemodule 'C_array'

Voor iedere ListBox in het Userform kun je gebruik maken van een klassemodule.
Daarin staat de code die bij een bepaalde aktie wordt uitgevoerd.
Daarvoor moet je iedere ListBox toewijzen aan een aparte instantie van de klassemodule.
Die afzonderlijke instanties bewaar je in een Object-variabele die een verzameling kan bevatten.
Dat kan bijv. een Array, een Dictionary of een Collection zijn.
In het voorbeeldbestand gebruiken we een Array.

De code in Userform 'U_array_class'

In het declaratiedeel van de macromodule declareren we array 'sc' met drie elementen.
Aan ieder element in de Array 'sc' wijzen we een nieuwe instantie van de klassemodule 'C_array' toe.
Iedere keuzelijst in het Userform koppelen we aan de klassemodule.

Dim sc(2) As New C_array

Private Sub UserForm_Initialize()

For j = 0 To UBound(sc)

Set sc(j).c_list = Me("L_0" & j + 1)

End Sub

Om de eerste keuzelijst voor listBox L_01 te genereren aktiveren we L_01

L_01 = True

De code in klassemodule 'C_array'

Het declaratiedeel bevat de declaratie als UserformListBox van object-variabele 'c_list', die geaktiveerd wordt als gebeurteniscode (WithEvents).

Public WithEvents c_list As MSForms.ListBox

Het declaratiedeel bevat ook een Private declaratie van de array variabele 'sn'.
Die is bedoeld voor het inlezen van de databasegegevens.
Door deze declaratie blijft de ingelezen database in het geheugen beschikbaar en hoeft zo maar 1 keer ingelezen te worden.

Voor de gebeurtenis 'Change' is een procedure opgenomen.
Eerst wordt gecontroleerd of de database al is ingelezen.
Als dat niet het geval is, gebeurt dat.

If IsEmpty(sn) Then sn = Sheet2.ListObjects(1).DataBodyRange.Resize(, 5)

De Objectvariabele 'c_list' verwijst naar de gewijzigde Listbox uit het Userform.
Aan de hand van de naam wordt het nummer (y) van de Listbox bepaald, zodat de volgende afhankelijke ListBoxen leeg kunnen worden gemaakt.
Voor het genereren van de eerste keuzelijst wordt y op 0 gesteld.

y = Val(Right(c_list.Name, 1)) + (c_list.ListCount = 0)

Maak de vervolgkeuzelijsten leeg

Iedere ListBox staat in een Frame.
Het Frame fungeert als 'Parent' voor de Listbox.
De 'Parent' van het Frame is het Userform.
Als we andere controls van het Userform willen aanspreken moet dat via de Parent.Parent eigenschap van de objectvariabele c_list.
De volgende, afhankelijke, keuzelijsten worden leeggemaakt.

With c_list.Parent.Parent

For j = y + 1 To 4

.Controls("L_0" & j).ListIndex = -1
.Controls("L_0" & j).Clear

Genereer de volgende keuzelijst

De reeds gemaakte keuzen worden gecombineerd in variabele c00.
De in arrayvariabele 'sn' opgeslagen database wordt doorlopen.
In array 'st' wordt getoetst of het record aan de reeds gemaakte keuzen voldoet.
Ook wordt getoetst of de waarde in het volgende veld per record in de keuzelijststring c01 staat.
Als de recordwaarden voldoen en de volgende waarde ontbreekt wordt die toegevoegd aan de string met unieke waarden (c01).
Als de waarden niet meer overeenkomen en er een string met unieke waarden bestaat, stop dan het zoeken.

c00 = .L_01 & .L_02 & .L_03 For j = 1 To UBound(sn)

Wijs de keuzelijst toe

De keuzelijststring c01 wordt in een array gesplitst en toegewezen aan de eerstvolgende keuzelijst.
Als de lijst slechts 1 item bevat wordt die geselecteerd.

With .Controls("L_0" & y + 1)

.List = Split(Mid(c01, 2), "|")
If .ListCount = 1 Then .ListIndex = 0

End With

De volledige code

Public WithEvents c_list As MSForms.ListBox
Dim sn

Private Sub c_list_change()

For j = y + 1 To 4

.Controls("L_0" & j).ListIndex = -1
.Controls("L_0" & j).Clear

Next

c00 = .L_01 & .L_02 & .L_03
For j = 1 To UBound(sn)

Next

With .Controls("L_0" & y + 1)

.List = Split(Mid(c01, 2), "|")
If .ListCount = 1 Then .ListIndex = 0

End With

End Sub

2.5 Advanced Filter

De methode Advanced Filter komt alleen in Excel voor.
Advanced Filter bevat een optie om lijsten met unieke gegevens te genereren.
Advanced Filter gebruikt twee gebieden in een werkblad:
- voor de filtercriteria
- voor de filterresultaten

Deze gebieden staan in het voorbeeldbestand in het verborgen werkblad 'PT' (codename: 'sheet3').
Het criteriumgebied bevat de namen van de te filteren kolommen uit de database in Range P1:R1.
De filtercriteria komen in gebied P2:R2 te staan.
Een enkele kolom van het te filteren gebied kan gekopieerd worden naar het resultaatgebied als het resultaatgebied de overeenkomstige kolomnaam bevat.
In werkblad 'PT' zijn 4 resultaatgebieden vastgelegd:
- kolom U voor de eerste databasekolom: kolomnaam 'Stadt'
- kolom W voor de tweede databasekolom: kolomnaam 'Zug'
- kolom Y voor de derde databasekolom: kolomnaam "Gruppe'
- kolom AA en AB voor de vierde kolom: kolomnaam 'Mitglieder' en 'Vorname'

De filterresultaten komen altijd in een werkblad terecht.
Als je vooraf alle mogelijke keuzelijsten zou willen maken, zou dat in het voorbeeldbestand tot een gebied met 210 kolommen leiden.
Gezien het grote aantal lees- en schrijfbewerkingen in het werkblad lijkt dat niet praktisch en zeker niet snel.
Daarom bespreek ik deze werkwijze voor de methode Advanced Filter niet.

2.5.1 Advanced Filter: filter achteraf

De code in Userform 'U_advanced_filter'

Bij het laden van het userform worden alle gegevens in het criteriumgebied en het resultatengebied gewist.
Daarna wordt de keuzelijstgeneratormacro M_list aangeroepen.
Met het argument (y) wordt doorgegeven om welke keuzelijst het gaat.

Private Sub UserForm_Initialize()

Sheet3.Cells(2, 16).Resize(40, 13).ClearContents

M_list 0

End Sub

Iedere keus in een keuzelijst start de gebeurteniscode van de keuzelijst.
Die start de gemeenschappelijke macro 'M_List' en geeft het nummer van de keuzelijst als argument door.

Private Sub L_01_Change()

M_list 1

End Sub

De code in macro 'M_list'

Maak de vervolgkeuzelijsten leeg

For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1
Me("L_0" & j).Clear

Genereer de volgende keuzelijst

In het criteriumgebied geef je aan op welke kolommen gefilterd moet worden.
Dat doe je met de kolomnamen van de database.
In dit geval de kolomnamen: 'Stadt', 'Zug' en 'Gruppe'.
Deze namen staan al in Sheet3, Range("P1:R1")
Zet het filtercriterium in het criteriumgebied in rij 2: Range("P2:R2")

If y > 0 Then .Cells(2, 15).Offset(, y).Resize(, 3) = Array(Me("L_0" & y), "", "")

Met advancedfilter kun je ook filteren welke kolom of kolommen je als resultaat wil krijgen.
Alleen de uit de database gefilterde gegevens van die kolom worden dan naar de kolom met dezelfde kolomnaam in het resultaatgebied geschreven.
In dit geval de kolom 'Stadt' in de kolom beginnend met Range("U1"), kolom 'Zug' in Range("W1"), kolom 'Gruppe' in Range("Y1").
Omdat we in de vierde lijst niet alleen de namen van de 'Mitglieder' willen hebben, maar ook hun 'Vorname', bevat de Rang("AA1:AB1") de kolomnamen 'Mitglieder', resp. 'Vorname'.
Omdat de vierde lijst uit 2 kolommen bestaat is ListBox L_01 de eigenschap .Listcount 2 toegewezen.

Bepaal de kolom (n) voor het resultaatgebied en verwijder eventueel daar aanwezige resultaatgegevens

With Sheet3

n = 21 + 2 * y
.Cells(1, n).CurrentRegion.Offset(1).ClearContents

End With

- Filter de database, - kopieer de gegevens: 2, - gebruik het criteriumgebied, - kopieer naar de resultaatkolom(men) en - houd alleen unieke waarden over: -1
Zet de gegevens van de resultaatkolom in variabele sp

With Sheet3

If y > 0 Then .Cells(2, 15).Offset(, y).Resize(, 3) = Array(Me("L_0" & y), "", "")

n = 21 + 2 * y
.Cells(1, n).CurrentRegion.Offset(1).ClearContents
Sheet2.Cells(1).CurrentRegion.AdvancedFilter 2, .Cells(1, 16).CurrentRegion, .Cells(1, n).CurrentRegion, -1
sp = .Cells(1, n).CurrentRegion

End With

Wijs de keuzelijst toe aan de volgende ListBox

Wijs de variabele sp toe aan de volgende keuzelijst.
Selekteer het enige element van de keuzelijst als deze slechts 1 item bevat.

With Me("L_0" & y + 1)

.List = sp
If .ListCount = 1 Then .ListIndex = 0

End With

2.5.2 Advanced Filter: filter vooraf

Deze methode is niet praktisch bij het gebruik van Advanced Filter en komet niet aan bod.

2.5.3 Advanced Filter met gebeurtenisklasse

De code bevindt zich in Userform 'U_advanced_filter_class' en de klassemodule 'C_advancedfilter'

Voor iedere ListBox in het Userform kun je gebruik maken van een klassemodule.
Daarin staat de code die bij een bepaalde aktie wordt uitgevoerd.
Daarvoor moet je iedere ListBox toewijzen aan een aparte instantie van de klassemodule.
Die afzonderlijke instanties bewaar je in een Object-variabele die een verzameling kan bevatten.
Dat kan bijv. een Array, een Dictionary of een Collection zijn.
In het voorbeeldbestand gebruiken we een Array.

De code in Userform 'U_advanced_filter_class'

In het declaratiedeel van de macromodule declareren we array 'sc' met drie elementen.
Aan ieder element in de Array 'sc' wijzen we een nieuwe instantie van de klassemodule 'C_advancedfilter' toe.
Iedere Listbox in het Userform koppelen we via zo'n instantie aan de klassemodule.

Dim sc(2) As New C_advancedfilter

Private Sub UserForm_Initialize()

For j = 0 To UBound(sc)

Set sc(j).c_list = Me("L_0" & j + 1)

End Sub

Om de eerste keuzelijst voor listBox L_01 te genereren aktiveren we L_01

L_01=true

De code in klassemodule 'C_advancedfilter'

Het declaratiedeel bevat de declaratie als UserformListBox van object-variabele 'c_list', die geaktiveerd wordt als gebeurteniscode (WithEvents).

Public WithEvents c_list As MSForms.ListBox

y = Val(Right(c_list.Name, 1)) + (c_list.ListCount = 0)

Maak de vervolgkeuzelijsten leeg

Iedere ListBox staat in een Frame.
Het Frame fungeert als 'Parent' voor de Listbox.
De 'Parent' van het Frame is het Userform.
Als we andere controls van het Userform willen aanspreken moet dat via de .Parent.Parent eigenschap van de objectvariabele c_list.
De volgende, afhankelijke, keuzelijsten worden leeggemaakt.

With c_list.Parent.Parent

For j = y + 1 To 4

.Controls("L_0" & j).ListIndex = -1
.Controls("L_0" & j).Clear

Genereer de volgende keuzelijst

Het criteriumgebied P2:R2 wordt gevuld met de keuzes in keuzelijsten L_01 t/m L_03.
De kolom (n) van het resultaatgebied wordt bepaald.
Deze resultaatkolom wordt leeggemaakt, met uitzondering van de kolomnaam.
De database in sheet 'Data' wordt gefilterd en het resultaat naar de resultaatkolom geschreven.
De gegevens in de resultaatkolom worden in Array-variabele 'sp' gezet.

With Sheet3

.Cells(2, 15).Offset(, y).Resize(, 3) = Array(c_list, "", "")

n = 21 + 2 * y
.Cells(1, n).CurrentRegion.Offset(1).ClearContents
Sheet2.Cells(1).CurrentRegion.AdvancedFilter 2, .Cells(1, 16).CurrentRegion, .Cells(1, n).CurrentRegion, -1
sp = .Cells(1, n).CurrentRegion

End With

Wijs de keuzelijst toe aan de volgende ListBox

De filterresultaten in arrayvariabele 'sp' worden toegewezen aan de volgende ListBox in het Userform.
De titel van de resultaatkolom wordt uit de ListBox verwijderd.
Als de Listbox slechts 1 item bevat wordt dat geselecteerd.

With .Controls("L_0" & y + 1)

.List = sp
.RemoveItem 0
If .ListCount = 1 Then .ListIndex = 0

End With

De volledige code

Public WithEvents c_list As MSForms.ListBox

Private Sub c_list_change()

If c_list.ListCount > 0 And c_list.ListIndex = -1 Then Exit Sub

y = Val(Right(c_list.Name, 1)) + (c_list.ListCount = 0)

With c_list.Parent.Parent

For j = y + 1 To 4

.Controls("L_0" & j).ListIndex = -1
.Controls("L_0" & j).Clear

Next

With Sheet3

End With

With .Controls("L_0" & y + 1)

.List = sp
.RemoveItem 0
If .ListCount = 1 Then .ListIndex = 0

End With

End Sub

2.6 Autofilter

De methode Autofilter komt alleen in Excel voor.
Autofilter bevat geen optie om lijsten met unieke gegevens te genereren.
Daarvoor gebruik ik de Excel-methode 'RemoveDuplicates'.
Autofilter gebruikt een gebied in een werkblad om de resultaten weg te schrijven als kopie.
Ik gebruik daarvoor het verborgen werkblad "PT' (codename 'Sheet3').
Omdat er geschreven wordt in het werkblad gebruik ik screenupdating = false om schermflikkering te onderdrukken.

2.6.1 Autofilter: filter achteraf

Roep in gebeurtenis Userform_Initialize de macro 'M_list' aan om de eerste keuzelijst te genereren.
Geef nul als argument door, zodat duidelijk is dat het om de volgende (L_01) keuzelijst gaat.

Private Sub UserForm_Initialize()

M_list 0

End Sub

De code in macro 'M_List'

Schakel schermverversing uit.
Verwijder alle gegevesn in de doellokatie.
Stop de macro als een gevulde keuzelijst door andere code wordt leeggemaakt.
Maak alle volgende keuzelijsten leeg.

Application.ScreenUpdating = False

Sheet3.Cells(1, 100).CurrentRegion.Clear
If y > 0 Then If Me("L_0" & y).ListIndex = -1 Then Exit Sub

For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1
Me("L_0" & j).Clear

Genereeer de volgende keuzelijst

Afhankelijk van het argument y wordt per keuzelijst een filter gezet op overeenkomende kolommen.
Het autofilter wordt toegepast op de database in de dynamische tabel (ListObject) in sheet 'Data' (=Sheet2).

With Sheet2.ListObjects(1).Range

If y = 0 Then .AutoFilter 1, "<>"""
If y > 0 Then .AutoFilter 1, L_01
If y > 1 Then .AutoFilter 2, L_02
If y > 2 Then .AutoFilter 3, L_03

End With

Het filterresultaat wordt naar range("CV1") van werkblad 'PT' gekopieerd.
Bij de derde keuzelijst worden zowel de kolom met 'Mitglieder' als "Vorname' gekopieerd.
Het autofilter wordt uitgeschakeld.

.Columns(y + 1).Resize(, IIf(y = 3, 2, 1)).Copy Sheet3.Cells(1, 100)
.AutoFilter

Verwijder dubbele items

Voor de keuzelijsten 1 t/m 3 worden dubbele waarden verwijderd.

If y < 3 Then Sheet3.Cells(1, 100).CurrentRegion.RemoveDuplicates 1, 1

Wijs het resultaatgebied toe aan de volgende ListBox

De gegevens in de kolom(men) van range "CV1" worden toegewezen aan de volgende ListBox.
De koptekst wordt altijd mee toegewezen, omdat anders Excel bij slechts 1 waarde van de Array een ander gegevenstype maakt.
Na toewijzing in de Listbox wordt de kolomkop uit de ListBox verwijderd.
Selekteer het enige element van de keuzelijst als deze slechts 1 item bevat.

With Me("L_0" & y + 1)

.List = Sheet3.Cells(1, 100).CurrentRegion.Value
.RemoveItem 0
If .ListCount = 1 Then .ListIndex = 0

End With

De volledig code

Application.ScreenUpdating = False
Sheet3.Cells(1, 100).CurrentRegion.Clear
If y > 0 Then If Me("L_0" & y).ListIndex = -1 Then Exit Sub

For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1
Me("L_0" & j).Clear

Next

With Sheet2.ListObjects(1).Range

If y = 0 Then .AutoFilter 1, "<>"""
If y > 0 Then .AutoFilter 1, L_01
If y > 1 Then .AutoFilter 2, L_02
If y > 2 Then .AutoFilter 3, L_03
.Columns(y + 1).Resize(, IIf(y = 3, 2, 1)).Copy Sheet3.Cells(1, 100)
.AutoFilter

End With
If y < 3 Then Sheet3.Cells(1, 100).CurrentRegion.RemoveDuplicates 1, 1

With Me("L_0" & y + 1)

.List = Sheet3.Cells(1, 100).CurrentRegion.Value
.RemoveItem 0
If .ListCount = 1 Then .ListIndex = 0

End With

2.6.2 Autofilter: filter vooraf

Het autofilter maakt gebruik van een werkblad om gefilterde gegevens weer te geven.
In dit voorbeeld zou daarvoor een gebied met 211 kolommen nodig zijn.
Door het grote aantal lees- en schrijfbewerkingen zou deze aanpak te traag zijn.
Deze aanpak werken we niet verder uit.

2.6.3 Autofilter met gebeurtenisklasse

De code bevindt zich in Userform 'U_autofilter_class' en de klassemodule 'C_autofilter'

Voor iedere ListBox in het Userform kun je gebruik maken van een klassemodule.
Daarin staat de code die bij een bepaalde aktie wordt uitgevoerd.
Daarvoor moet je iedere ListBox toewijzen aan een aparte instantie van de klassemodule.
Die afzonderlijke instanties bewaar je in een Object-variabele die een verzameling kan bevatten.
Dat kan bijv. een Array, een Dictionary of een Collection zijn.
In het voorbeeldbestand gebruiken we een Array.

De code in Userform 'U_autofilter_class'

Dim sc(2) As New C_autofilter

Private Sub UserForm_Initialize()

For j = 0 To UBound(sc)

Set sc(j).c_list = Me("L_0" & j + 1)

End Sub

Om de eerste keuzelijst voor listBox L_01 te genereren aktiveren we ListBox 1: L_01

L_01 = True

De code in klassemodule 'C_autofilter'

Het declaratiedeel bevat de declaratie als UserformListBox van object-variabele 'c_list', die geaktiveerd wordt als gebeurteniscode (WithEvents).

Public WithEvents c_list As MSForms.ListBox

y = Val(Right(c_list.Name, 1)) + (c_list.ListCount = 0)

Leegmaken volgende keuzlijsten

Iedere ListBox staat in een Frame.
Het Frame fungeert als 'Parent' voor de Listbox.
De 'Parent' van het Frame is het Userform.
Als we andere controls van het Userform willen aanspreken moet dat via de Parent.Parent eigenschap van de objectvariabele c_list.
De volgende, afhankelijke, keuzelijsten worden leeggemaakt.

With c_list.Parent.Parent

For j = y + 1 To 4

.Controls("L_0" & j).ListIndex = -1
.Controls("L_0" & j).Clear

Genereer de volgende keuzelijst

De huidige keuzen in de keuzelijsten (L_01, L_02 en L_03) worden in arrayvariabele 'st' gezet.
De database in werkblad 'Data' ( = Sheet2) in het Listobject wordt gefilterd per kolom met de waarden uit de keuze lijsten.
Het gefilterde resultaat wordt gekopieerd naar werkblad 'PT', in cel "CV1".
Na de keuze in de derde keuzelijst worden 2 kolommen gekopieerd.
Voor de eerste drie keuzelijsten worden dubbele waarden verwijderd.

sn = Array(.L_01, .L_02, .L_03) With Sheet2.ListObjects(1).Range

.AutoFilter 1, IIf(y = 0, "<>""", .sn(0))
If y > 1 Then .AutoFilter 2, .sn(1)
If y > 2 Then .AutoFilter 3, sn(2)
.Columns(y + 1).Resize(, IIf(y = 3, 2, 1)).Copy Sheet3.Cells(1, 100)
.AutoFilter

End With
If y < 3 Then Sheet3.Cells(1, 100).CurrentRegion.RemoveDuplicates 1, 1

Wijs het resultaatgebied toe aan de volgende keuzelijst

De Range met het filterresultaat wordt toegewezen aan de volgende keuzelijst.
Omdat de vierde keuzelijst over 2 kolommen gaat krijgt deze lijst (L_04) de eigenschap .Listcount = 2, zodat bied kolommen tegelijkertijd in l_04 worden getoond.
De kolomtitel wordt verwijderd.
Als de keuzelijst slechts 1 item bevat wordt deze geselecteerd.

With .Controls("L_0" & y + 1)

.List = Sheet3.Cells(1, 100).CurrentRegion.Value .RemoveItem 0 If .ListCount = 1 Then .ListIndex = 0

End With

2.7 Evaluate

De methode Evaluate komt alleen in Excel voor.
Daarbij maak je gebruik van Excelformules in de vorm van een Array-formule.
Alleen in speciale gevallen kun je het resultaat uit unieke waarden laten bestaan.
Omdat de database in een dynamische tabel staat, kunnen we in de Evaluate-benadering gebruikmaken van de eigenschappen van die tabel.

De Databasetabel heet 'snb'.
Alle gegevens van de kolom met kolomkop 'Stadt' kun je aanduiden met 'snb[Stadt]'
Er zijn twee schrijfvormen voor de 'Evaluate'-methode:
- een tekenreeks met Excelformules als tekstargument voor de methode 'Evaluate': Evaluate(" ... ")
- Excelformules ingesloten tussen rechte haken: [ ... ]

2.7.1 Evaluate: filter achteraf

De code in Userform 'U_evaluate'

In de Userform_initialize procedure staat de code om de eerste Listbox te vullen.
Genereer de lijst met unieke stadsnamen en wijs die toe aan de eerste ListBox:

Private Sub UserForm_Initialize()

L_01.List = Filter([transpose(if(countif(offset(Data!A1,,,row(snb[Stadt])),snb[Stadt])=1,snb[Stadt],"~"))], "~", 0)

End Sub

Start de gemeenschappelijke macro 'M_list' bij iedere keus

Een keus in een van de keuzelijsten aktiveert de gebeurteniscode _change.
Die start de gemeenschappelijke macro 'M_list' en geeft het nummer van de keuzelijst als argument door.

Private Sub L_01_Change()

M_list 1

End Sub

De code in macro 'M_list'

Maak alle volgende keuzelijsten leeg

For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1
Me("L_0" & j).Clear

Genereer de volgende keuzelijst

Zet de tot dan toe gekozen waarden in de keuzelijst in een cel in een werkblad.
Dit is nodig om de evaluate-funktie ernaartoe te laten verwijzen.
Het maakt niet uit in welke cel, als er in de evaluate-formule maar goed naar verwezen wordt.
In het voorbeeld cel G1 in werkblad 'PT'.
En filter voor iedere keuzelijst afzonderlijk alle records die aan de voorwaarde in cel G1 voldoen:

Sheet3.Cells(1, 7) = L_01 & L_02 & L_03

If y = 1 Then sn = Filter([transpose(if(snb[Stadt]=PT!G1,snb[Zug]&"_","~"))], "~", 0)
If y = 2 Then sn = Filter([transpose(if(snb[Stadt]&snb[Zug]=PT!G1,snb[Gruppe]& "_","~"))], "~", 0)
If y = 3 Then sn = Filter([transpose(if(snb[Stadt]&snb[Zug]&snb[Gruppe]=PT!G1,snb[Mitglieder] & ", " & snb[Vorname],""))], ",")

Verwijder alle dubbele items en sla de unieke op in de string variabele c00.
Splits de unieke items in de variabele sn

If y < 3 Then

c00 = c00 & "|" & Replace(sn(0), "_", "")
sn = Filter(sn, sn(0), 0)

Loop Until UBound(sn) = -1

sn = Split(Mid(c00, 2), "|")

End If

Wijs de keuzelijst toe aan de volgende ListBox

Wijs de variabele toe aan de volgende keuzelijst.
Selekteer het enige element van de keuzelijst als deze slechts 1 item bevat.

With Me("L_0" & y + 1)

.List = sn
If .ListCount = 1 Then .ListIndex = 0

End With

2.7.2 Evaluate: filter vooraf

Om met Evaluate gemaakte keuzelijsten te kunnen bewaren moet je gebruik maken van het werkblad of een opslagmethode in het geheugen, bijv. Dictionary, Array, Collection.
De evaluate-methode is met andere woorden alleen geschikt voor keuzelijstproduktie meteen nadat de gebruiker een keuze heeft gemaakt.

2.7.3 Evaluate met gebeurtenisklasse

De code bevindt zich in Userform 'U_evaluate_class' en de klassemodule 'C_evaluate'

Voor iedere ListBox in het Userform kun je gebruik maken van een klassemodule.
Daarin staat de code die bij een bepaalde aktie wordt uitgevoerd.
Daarvoor moet je iedere ListBox toewijzen aan een aparte instantie van de klassemodule.
Die afzonderlijke instanties bewaar je in een Object-variabele die een verzameling kan bevatten.
Dat kan bijv. een Array, een Dictionary of een Collection zijn.
In het voorbeeldbestand gebruiken we een Array.

De code in Userform 'U_evaluate_class'

Koppel listboxen aan klassemodule

In het declaratiedeel van de macromodule declareren we array 'sc' met drie elementen.
Aan ieder element in de Array 'sc' wijzen we een nieuwe instantie van de klassemodule 'C_evaluate' toe.
Iedere Listbox wordt via de afzonderlijke instantie gekoppeld aan de klassemodule.

Dim sc(2) As New C_evluate

Private Sub UserForm_Initialize()

For j = 0 To UBound(sc)

Set sc(j).c_list = Me("L_0" & j + 1)

End Sub

Genereer keuzelijst in eerste ListBox

De eerste keuzelijst voor listBox L_01 genereren we zó

L_01.List = Filter([transpose(if(countif(offset(Data!A1,,,row(snb[Stadt])),snb[Stadt])=1,snb[Stadt],"~"))], "~", 0)

De code in klassemodule 'C_evaluate'

Het declaratiedeel bevat de declaratie als UserformListBox van object-variabele 'c_list', die geaktiveerd wordt als gebeurteniscode (WithEvents).

Public WithEvents c_list As MSForms.ListBox

y = Val(Right(c_list.Name, 1))

With c_list.Parent.Parent

For j = y + 1 To 4

.Controls("L_0" & j).ListIndex = -1
.Controls("L_0" & j).Clear

Genereer volgende keuzelijst

De gemaakte keuzen worden in werkblad 'PT" in cel G1 gezet.
Per keuzelijst wordt gecontroleerd of records uit de database voldoen aan de reeds gemaakte keuzen.

Sheet3.Cells(1, 7) = .L_01 & .L_02 & .L_03

If y = 1 Then sn = Filter([transpose(if(snb[Stadt]=PT!G1,snb[Zug]&"_","~"))], "~", 0) If y = 2 Then sn = Filter([transpose(if(snb[Stadt]&snb[Zug]=PT!G1,snb[Gruppe]&"_","~"))], "~", 0) If y = 3 Then sn = Filter([transpose(if(snb[Stadt]&snb[Zug]&snb[Gruppe]=PT!G1,snb[Mitglieder] & ", " & snb[Vorname],""))], ",")

De resulterende array-variabele 'sn' wordt ontdaan van dubbele waarden.

If y < 3 Then

c00 = c00 & "|" & Replace(sn(0), "_", "")
sn = Filter(sn, sn(0), 0)

Loop Until UBound(sn) = -1 sn = Split(Mid(c00, 2), "|")

End If

Wijs keuzelijst toe aan de volgende ListBox

De array-variabele wordt toegewezen aan de volgende keuzelijst.
Als de keuzelijst slechts 1 item bevat wordt dat geselecteerd.

With .Controls("L_0" & y + 1)

.List = sn If .ListCount = 1 Then .ListIndex = 0

End With

De volledige code

Public WithEvents c_list As MSForms.ListBox

Private Sub c_list_change()

If c_list.ListIndex = -1 Then Exit Sub

y = Val(Right(c_list.Name, 1))

With c_list.Parent.Parent

For j = y + 1 To 4

.Controls("L_0" & j).ListIndex = -1
.Controls("L_0" & j).Clear

Next

Sheet3.Cells(1, 7) = .L_01 & .L_02 & .L_03
If y = 1 Then sn = Filter([transpose(if(snb[Stadt]=PT!G1,snb[Zug]&"_","~"))], "~", 0)
If y = 2 Then sn = Filter([transpose(if(snb[Stadt]&snb[Zug]=PT!G1,snb[Gruppe]&"_","~"))], "~", 0)
If y = 3 Then sn = Filter([transpose(if(snb[Stadt]&snb[Zug]&snb[Gruppe]=PT!G1,snb[Mitglieder] & ", " & snb[Vorname],""))], ",")

If y < 3 Then

c00 = c00 & "|" & Replace(sn(0), "_", "")
sn = Filter(sn, sn(0), 0)

Loop Until UBound(sn) = -1
sn = Split(Mid(c00, 2), "|")

End If

With .Controls("L_0" & y + 1)

.List = sn
If .ListCount = 1 Then .ListIndex = 0

End With

End Sub

2.8 Pivottable

Alleen Excel bevat draaitabellen (Pivottables).
Een draaitabel kan op basis van een databasetabel een boomstruktuur maken van afhankelijke velden.
Een draaitabel is verbonden met een database en hoeft slechts 1 keer gemaakt te worden.
Wijzigingen in de database die aan de draaitabel is gekoppeld kunnen met de instructie 'refresh' in de draaitabel geactualiseerd worden.
Een draaitabel kan op allerlei manieren weergegeven worden.
De boomstruktuur vereist een weergave in tabelvorm zonder subtotalen en andere totalen.
De draaitabel genereert zelf alle mogelijke keuzelijsten die we in het Userform nodig zouden kunnen hebben.
Het enige wat we in het Userform hoeven te doen is - de gebruiker een keuzelijst presenteren, - de gebruiker een keuze laten maken en - op basis van die keuze de vervolgkeuzelijst uit de draaitabel inlezen in de volgende ListBox.

De eenmalige VBA-code om zo'n draaitabel te maken is als volgt: NB. de databasetabel staat in Sheet2. De draaitebal komt terecht in Sheet3.

Sub M_snb()

Application.ScreenUpdating = False

With ThisWorkbook.PivotCaches.Create(1, Sheet2.ListObjects(1).Range.Resize(, 5)).CreatePivotTable(Sheet3.Cells(1, 10), "snb_000")

For j = 1 To 5

.PivotFields(j).Orientation = 1
.PivotFields(j).Subtotals = Array(False, False, False, False, False, False, False, False, False, False, False, False)
If j > 1 And j < 5 Then .PivotFields(j - 1).ShowDetail = False

Next

.RowAxisLayout 1
.ColumnGrand = False
.RowGrand = False
.PivotFields(4).RepeatLabels = True

End With

End Sub

Een draaitabel staat altijd in een werkblad.
In het voorbeeldbestand in het verborgen werkblad 'PT' (codename sheet3).
De gegevens uit de draaitabel staan in rijen en kolommen.
Daarom kunnen we ieder deel van de draaitabel als range inlezen in een ListBox in het userform.

2.8.1 Pivottable: filter achteraf

Omdat een draaitabel, eenmaal gemaakt, blijft funktioneren is het gebruik per definitie een filtering van keuzelijsten voorafgaande aan enige keus van de gebruiker.
De filtering achteraf is daarom niet van toepassing.

2.8.2 Pivottable: filter vooraf

De code in Userform in 'U_pivottable'

Als we het Userform openen:
- ververs de gegevens van de draaitabel.
- verberg de detailgegevens van alle kolommen/velden
- de laatste kolom kan logischerwijze geen details vertonen.
- wijs de gegevens van de eerste kolom toe aan de eerste ListBox L_01.

Private Sub UserForm_Initialize()

With Sheet3.PivotTables(1)

.RefreshTable
For Each it In .PivotFields

If it.Name <> "Vorname" Then it.ShowDetail = False

Next

L_01.List = .PivotFields(1).DataRange.SpecialCells(2).Value

End With

End Sub

Een keus door de gebruiker aktiveert de gebeurtenisprocedure _change. De gebeuertenisprocedures start de macro 'M_list'.
Het nummer van de keuzelijst wordt als argument doorgegeven aan de macro M_list'.

Private Sub L_01_Change()

M_list 1

End Sub

De code in macro 'M_list'

Maak de vervolgkeuzen leeg en de overeenkomstige draaitabelvelden onzichtbaar

Als geen keuze is gemaakt, wordt de macro beëindigd.
De draaitabel staat in een werkblad.
Wijzigingen in de weergave van de draaitabel leiden tot schermverversing.
Die wordt zichtbaar door ongewenste schemflikkeringen.
Die ondervangen we met het uitschakelen van de schermverversing.
De volgende keuzelijsten worden leeggemaakt.
De details van de volgende pivottable-kolommen worden verborgen.

Sub M_list(y)

If Me("L_0" & y).ListIndex = -1 Then Exit Sub

Application.ScreenUpdating = False

For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1
Me("L_0" & j).Clear
Sheet3.PivotTables(1).PivotFields(j).ShowDetail = False

Wijs de details van het gekozen draaitabelitem toe aan de volgende ListBox

De detailgegevens van de met de keuzelijst corresponderende kolom in de draaitabel worden niet-zichtbaar.
Alleen de details van het gekozen item in de keuzelijst worden in de draaitabel zichtbaar.
Deze gegevens worden als Range toegewezen aan de volgende ListBox.
Als de Range uit slechts 1 cel bestaat wordt die uitgebreid om te voorkomen dat Excel de Range in een ander gegevenstype wijzigt.
De vierde ListBox moet met 2 kolommen gevuld worden: 'Mitglieder' en 'Vorname'.
Daarvoor zorgt de instruktie 'resize' .
De vierde Listbox L_04 heeft als .columncount eigenschap 2, zodat beide kolommen zichtbaar zijn.

With Sheet3.PivotTables(1)

.PivotFields(y).ShowDetail = False
.PivotFields(y).PivotItems(Me("L_0" & y).Value).ShowDetail = True
If y = 3 Then .PivotFields(4).ShowDetail = True

With .PivotFields(y + 1).DataRange.SpecialCells(2)

Me("L_0" & y + 1).List = .Resize(.Count - (.Count = 1), IIf(y = 3, 2, 1)).Value

End With

Als de ListBox een leeg element bevat om te voorkomen dat Excel de Range naar een ander gegevenstype converteert, wordt dat lege element verwijderd.
Als de ListBox slechts 1 element bevat, wordt dat geselecteerd.

With Me("L_0" & y + 1)

If .List(1, 0) = "" Then .RemoveItem 1
If .ListCount = 1 Then .ListIndex = 0

End With

2.8.3 Pivottable met gebeurtenisklasse

De code bevindt zich in Userform 'U_pivottable_class' en de klassemodule 'C_pivottable'

Voor iedere ListBox in het Userform kun je gebruik maken van een klassemodule.
Daarin staat de code die bij een bepaalde aktie wordt uitgevoerd.
Daarvoor moet je iedere ListBox toewijzen aan een aparte instantie van de klassemodule.
Die afzonderlijke instanties bewaar je in een Object-variabele die een verzameling kan bevatten.
Dat kan bijv. een Array, een Dictionary of een Collection zijn.
In het voorbeeldbestand gebruiken we een Array.

De code in Userform 'U_pivottable_class'

In het declaratiedeel van de macromodule declareren we array 'sc' met drie elementen.
Aan ieder element in de Array 'sc' wijzen we een nieuwe instantie van de klassemodule 'C_pivottable' toe.
Iedere ListBox in het userform koppelen we via de afzonderlijke instanties aan de klassemodule.

Dim sc(2) As New C_advancedfilter

Private Sub UserForm_Initialize()

For j = 0 To UBound(sc)

Set sc(j).c_list = Me("L_0" & j + 1)

End Sub

Om de eerste keuzelijst voor listBox L_01 te genereren aktiveren we L_01

L_01=true

De code in klassemodule 'C_pivottable'

Het declaratiedeel bevat de declaratie als UserformListBox van object-variabele 'c_list', die geaktiveerd wordt als gebeurteniscode (WithEvents).

Public WithEvents c_list As MSForms.ListBox

y = Val(Right(c_list.Name, 1)) + (c_list.ListCount = 0)

Leegmaken volgende keuzelijsten

Iedere ListBox staat in een Frame.
Het Frame fungeert als 'Parent' voor de Listbox.
De 'Parent' van het Frame is het Userform.
Als we andere controls van het Userform willen aanspreken moet dat via de Parent.Parent eigenschap van de objectvariabele c_list.
Dit Userform wijzen we via de .Parent.Parent-eigenschap van c_list toe aan de object-variabele 'uf'.
De draaitabel in werkblad 'PT' wijze we toe aan Object-variabele 'PT'.
De volgende, afhankelijke, keuzelijsten worden leeggemaakt.
Ook alle details in volgende 'kolommen' van de draaitabel worden verborgen.

Set PT = Sheet3.PivotTables(1)
Set uf = c_list.Parent.Parent

For j = y + 1 To 4

uf.Controls("L_0" & j).ListIndex = -1
uf.Controls("L_0" & j).Clear
PT.PivotFields(j).ShowDetail = False

Genereer volgend keuzelijst en wijs toe aan de volgende ListBox

Als een keuze is gemaakt in een keuzelijst: verberg de details van de corresponderende kolom.
Als een keuze is gemaakt in een keuzelijst: toon alle details van de gemaakte keuze.
Als in de 3e keuzelijst een keuze is gemaakt : toon ook de details van de laatste kolom.
Wijs aan de volgende keuzelijst het gebied van de draaitabel met de zichtbare details toe.

With PT

If y > 0 Then .PivotFields(y).ShowDetail = False
If y > 0 Then .PivotFields(y).PivotItems(c_list.Value).ShowDetail = True
If y = .PivotFields.Count - 2 Then .PivotFields(.PivotFields.Count - 1).ShowDetail = True

With .PivotFields(y + 1).DataRange.SpecialCells(2)

uf.Controls("L_0" & y + 1).List = .Resize(.Count - (.Count = 1), IIf(y = 3, 2, 1)).Value

End With

Als het eerste item in de ListBox leeg is: verwijder het.
Als de Listbox slechts 1 item bevat: selecteer het.

With uf.Controls("L_0" & y + 1)

If .List(1, 0) = "" Then .RemoveItem 1
If .ListCount = 1 Then .ListIndex = 0

End With

2.9 TreeView

De TreeView maakt geen deel uit van de Standaard VBA-bibliotheek.
De bibliotheek Microsoft Windows Common Controls 6.0 (SP6) bevat de ListView.
Die kun je laden in de VBEditor via Tools/References, of door uitbreiding van de ToolBox met besturingselementen.

De TreeView kun je beschouwen als de grafische weergave van de Pivottable in Tabelvorm.
Ieder element is uitklapbaar om de afhankelijke subitems te tonen.
Het basiselement van de Treeview is de 'Node'.
Een TreeView bevat geen andere elementen dan 'Nodes'.
Via de argumenten van de methode Add kun je de relatie met andere Nodes aangeven.
Daardoor ontstaat er automatisch een boomstruktuur.
Iedere node heef een eigen sleutel, zodat het niet mogelijk is dat twee elementen dezelfde sleutel krijgen.
Als dreigt een bestaande sleutel overschreven te worden ontstaat een foutmelding.
Door de foutmelding te onderdrukken via 'on error resume next' blijven alleen unieke sleutels over.
De Treeview doet dus precies wat we willen: door het aanklikken van een element worden de daarvan afhankelijke vervolgkeuzen getoond.

2.9.1 TreeView: filter achteraf

De Treeview wordt eenmalig gevuld.
Omdat slechts een gevulde Treeview gebruikt kan worden is filtering achteraf per definitie niet van toepassing.

2.9.2 TreeView: filter vooraf

De database wordt ingelezen in variabele sn.
Per database 'record' wordt kolom 1 aangeduid als de 'Parent Node'.
Deze 'Node' heeft geen relatie met een andere Node en met de key sn(j,1).

De gegevens van kolom 2 worden geplaatst in een child (4) van de 'Parent Node' met de sleutel sn(j,1).
De sleutel van dit 'child': de recordwaarden van kolom 1 en 2 sn(j,1) & sn(j,2)
De waarde van dit 'child': de recordwaarde van kolom 2 sn(j,2).

De gegevens van kolom 3 worden geplaatst in een child (4) van de 'Child Node' met de sleutel sn(j,1) & sn(j,2).
De sleutel van dit 'child': de recordwaarden van kolom 1, 2 en 3 sn(j,1) & sn(j,2) & sn(j,3)
De waarde van dit 'child': de recordwaarde van kolom 3 sn(j,3).

De gegevens van kolom 4 worden geplaatst in een child (4) van de 'Child Node' met de sleutel sn(j,1) & sn(j,2) & sn(j,3).
De sleutel van dit 'child': de recordwaarden van kolom 1, 2, 3 en 4 sn(j,1) & sn(j,2) & sn(j,3)& sn(j,4)& sn(j,5).
De waarde van dit 'Child': de recordwaarden van de kolommen 4 en 5 sn(j,4) & ", " & sn(j,5).

Private Sub UserForm_Initialize()

sn = Sheet2.ListObjects(1).DataBodyRange

On Error Resume Next
For j = 1 To UBound(sn)

T_01.Nodes.Add , , sn(j, 1), sn(j, 1)
T_01.Nodes.Add sn(j, 1), 4, sn(j, 1) & sn(j, 2), sn(j, 2)
T_01.Nodes.Add sn(j, 1) & sn(j, 2), 4, sn(j, 1) & sn(j, 2) & sn(j, 3), sn(j, 3)
T_01.Nodes.Add sn(j, 1) & sn(j, 2) & sn(j, 3), 4, sn(j, 4) & sn(j, 5), sn(j, 4) & ", " & sn(j, 5)

End Sub

2.9.3 TreeView met gebeurtenisklasse

De Treeview reageert op de door de gebruiker gemaakte keuzen.
De Treeview toont de afhankelijke opties van iedere keuze.
Daarvoor hoeft geen code te worden geschreven.
Daarom is een klassemodule voor Treeview-gebeurtenissen overbodig/zinloos.

2.9.4 TreeView met CSV-bestand

In alle besproken VBA-methoden is uitgegaan van een databasetabel in een Excel werkblad. Je werkt niet altijd vanuit Excel en wil toch gebruik maken van afhankelijke keuzelijsten. Dezelfde tabel is opgeslagen als CSV-bestand met de komma als scheidingsteken.

De code in Userform 'U_treeview_csv'

Ter illustratie zijn 3 methodes opgenomen om een CSV bestand te lezen en de gegevens in een Treeview te zetten.
In principe zijn deze 3 methodes ook geschikt voor alle andere methoden om keuzelijsten te maken.
Van het CSV-bestand wordt nl. een 2-dimensionele Array gemaakt:
- de 'records' van het bestand worden geplitst met vbCrLf
- de 'fields' van het bestand worden per record gesplitst op de komma.

2.9.4.1 Scripting.FilesystemObject

Lees de gegevens in het CSV-bestand en zet ze, geplitst op vbCrLf in Array-variabele 'sn'.
Doorloop de variable 'sn'.
Splits ieder 'record' op komma in 'velden' en zet die in Array-variabele 'st'.
Voeg aan de Treeview per record de 'velden' met unieke sleutels toe.

Private Sub UserForm_Initialize()

c00 = ThisWorkbook.Path & "\"
c01 = "StadtZug.csv"

sn = Split(CreateObject("scripting.filesystemobject").opentextfile(c00 & c01).readall, vbCrLf)

On Error Resume Next
For j = 1 To UBound(sn)

st = Split(sn(j), ",")

With T_01.Nodes

.Add , , st(0), st(0)
.Add st(0), 4, st(0) & st(1), st(1)
.Add st(0) & st(1), 4, st(0) & st(1) & st(2), st(2)
.Add st(0) & st(1) & st(2), 4, st(3) & st(4), st(3) & ", " & st(4)

End With

End Sub

2.9.4.2 Freefile

Private Sub UserForm_Initialize()

c00 = ThisWorkbook.Path & "\"
c01 = "StadtZug.csv"

Open c00 & c01 For Input As #1

sn = Split(Input(LOF(1), 1), vbCrLf)

Close

On Error Resume Next
For j = 1 To UBound(sn)

st = Split(sn(j), ",")

With T_01.Nodes

.Add , , st(0), st(0)
.Add st(0), 4, st(0) & st(1), st(1)
.Add st(0) & st(1), 4, st(0) & st(1) & st(2), st(2)
.Add st(0) & st(1) & st(2), 4, st(3) & st(4), st(3) & ", " & st(4)

End With

End Sub

2.9.4.3 ADODB.Recordset

Lees de gegevens in het CSV-bestand en zet ze, gesplitst op vbCrLf in Array-variabele 'sn'.
Doorloop de variabele 'sn'.
Splits ieder 'record' op komma in 'velden' en zet die in Array-variabele 'st'.
Voeg aan de Treeview per record de 'velden' met unieke sleutels toe.

Private Sub UserForm_Initialize()

c00 = ThisWorkbook.Path & "\"
c01 = "StadtZug.csv"

With CreateObject("ADODB.recordset")

.Open "SELECT * FROM " & c01, "DRIVER={Microsoft Text Driver (*.txt; *.csv)};DBQ=" & c00
sn = Application.Index(.getrows, 0)
.Close

End With

On Error Resume Next
For j = 1 To UBound(sn)

st = Split(sn(j), ",")

With T_01.Nodes

.Add , , st(0), st(0)
.Add st(0), 4, st(0) & st(1), st(1)
.Add st(0) & st(1), 4, st(0) & st(1) & st(2), st(2)
.Add st(0) & st(1) & st(2), 4, st(3) & st(4), st(3) & ", " & st(4)

End With

End Sub

2.10 Arraylist

De ArrayList-bibliotheek is een aparte VBA-bibliotheek en kun je gebruiken in alle Office-programma's.
Die bibliotheek maak je actief met de ('late binding') instruktie:

With CreateObject("System.Collections.Arraylist")

end with

De ArrayList maakt geen gebruik van sleutels.
Een item kan een onbeperkt aantal keren als afzonderlijk item aan een ArrayList toegevoegd worden.
De ArrayList heeft een ingebouwde methode om te controleren of de Arraylist een bepaald item al bevat: .contains.
De ArrayList heeft een ingebouwde sorteermethode: .Sort of .Reverse.
De inhoud van de Arraylist kan als een-dimensionele Array uitgelezen worden met .Toarray.
Deze een-dimensionele Array kan gefilterd Filter(..,".") of tot string samengevoegd Join(...) worden.

2.10.1 Arraylist: filter achteraf

De code van het Userform 'U_arraylist'

Omdat we de interaktie met de Excel-applicatie tot een minimum willen beperken lezen we de tabelgegevens alleen in de Userform_initialize procedure in.
De ArrayList gebruiken we om alle unieke sleutel/waarden combinaties voor de keuzelijsten te bewaren.
Opdat dit maar 1 keer hoeft te gebeuren vullen we de Arraylist in de Initialize-gebeurtenis.
Omdat in de gemeenschappelijke macro 'M_list' uit de ArrayList de gewenste keuzelijst gefilterd moet worden, moeten we de objectvariabele 'al' waarin de Arraylist wordt opgeslagen als 'Private' declareren in het declaratiedeel van de macromodule van het Userform.

De code van Userform_Initialize

Declareer de variabele al.
Lees de databasetabel in in variabele 'sn'.
Wijs aan variabele 'al' een nieuwe instantie van het arrayList-object toe.
Doorloop de variabele 'sn' met de databasegegevens.
Een sleutel-waarde combinatie bestaat uit de waarde van een kolom, voorafgegaan door da samengevoegde waarden van de voorafgaande kolommen.
De sleutel en waarde worden gescheiden door een tilde "~".
Iedere sleutel krijgt een voor die kolom kenmerkende extra teken: pipeline "|", hekje "#", louter tilde "~" of niets.
Controleer per 'record' of de ArrayList al deze sleutel/waarde combinatie bevat.
Indien niet, voeg de sleutel/waarde-combinatie toe aan de Arraylist.
Filter uit de Arraylist de items zonder tilde en wijs die toe aan de eerste ListBox 'L_01'

Dim al

Private Sub UserForm_Initialize()

sn = Sheet2.ListObjects(1).DataBodyRange.Resize(, 5)

Set al = CreateObject("System.Collections.ArrayList") With al

For j = 1 To UBound(sn)

If Not .contains(sn(j, 1)) Then .Add sn(j, 1)
If Not .contains(sn(j, 1) & "~" & sn(j, 2)) Then .Add sn(j, 1) & "~" & sn(j, 2)
If Not .contains(sn(j, 1) & sn(j, 2) & "|~" & sn(j, 3)) Then .Add sn(j, 1) & sn(j, 2) & "|~" & sn(j, 3)
If Not .contains(sn(j, 1) & sn(j, 2) & sn(j, 3) & "#~" & sn(j, 4) & ", " & sn(j, 5)) Then .Add sn(j, 1) & sn(j, 2) & sn(j, 3) & "#~" & sn(j, 4) & ", " & sn(j, 5)

Next

L_01.List = Filter(.toarray, "~", 0)

End With

End Sub

Een keus in een Listbox aktiveert de overeenkomstige gebeurteniscode _Change.
De gebeurteniscode _change start de gemeenschappelijke Macro 'M_list'.
De code geeft het nummer van de keuzelijst door aan macro 'M_list'.

De code van macro 'M_list'

Maak alle volgende keuzelijsten leeg

For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1
Me("L_0" & j).Clear

Genereer de volgende keuzelijst en toe aan de volgende ListBox

Filter alle unieke sleutel-waarde combinaties in de Arraylist 'al' aan de hand van een criterium.
Het criterium is de combinatie van lijstkeuzes in variabele c00 met het voor de kolom kenmerkende teken.

c00 = L_01 & L_02 & L_03 & Trim(Mid(" |#", y, 1))

Filter de sleutel/waarde combinaties uit al.ToArray
Verwijder de sleutels, zodat alleen de waarden overblijven.
Wijs deze array toe aan de volgende keuzelijst.
Als een record overeenkomt zet dan het gegeven van de volgende kolom in een nieuw item van de ArrayList.

With Me("L_0" & y + 1)

.List = Filter(Split("^" & Join(Filter(al.toarray, c00 & "~"), ""), c00 & "~"), "^", 0)

If .ListCount = 1 Then .ListIndex = 0

End With

2.10.2 ArrayList: filter vooraf

De code in Userform 'U_arraylist_002'

In het declaratiedeel van de codemodule is een Private variabele gedeclareerd met de naam 'al'.
Deze variabele waaraan in de Initialize procedure een nieuwe Arraylist-instantie wordt toegewezen is nu toegankelijk in alle procedures van het Userform.

Dim al

In de Initialize procedure gebruiken we 2 Arraylists.
De eerste is 'Local' voor de inventarisatie van alle 3375 sleutel/waarde-combinaties.
De tweede is 'Private' en wordt toegewezen aan variabele 'al'.
In deze tweede Arraylist komen alle 211 keuzelijsten terecht. Inventariseer alle sleutel-waarde combinaties

Lees de databasetabel in in Array 'sn'.
Wijs een nieuwe Arrraylist-instantie toe aan variabele 'al'.

sn = Sheet2.ListObjects(1).DataBodyRange.Resize(,5)

Set al = CreateObject("System.Collections.ArrayList")

Maak een nieuwe Local Arraylist.
Loop door alle records van de database.
Stel per record aan de hand van de waarden in de eerste 5 kolommen de elementen van de keuzelijsten samen.
Controleer of dat element al in de ArrayList staat.
Zo niet, voeg het toe aan de ArrayList.
Deze Arraylist bestaat zodoende uit louter unieke elementen voor keuzelijsten.

With CreateObject("System.Collections.ArrayList")

For j = 1 To UBound(sn)
If Not .contains(sn(j, 1)) Then .Add sn(j, 1)
If Not .contains(sn(j, 1) & "~" & sn(j, 2)) Then .Add sn(j, 1) & "~" & sn(j, 2)
If Not .contains(sn(j, 1) & sn(j, 2) & "|~" & sn(j, 3)) Then .Add sn(j, 1) & sn(j, 2) & "|~" & sn(j, 3)
If Not .contains(sn(j, 1) & sn(j, 2) & sn(j, 3) & "#~" & sn(j, 4) & ", " & sn(j, 5)) Then .Add sn(j, 1) & sn(j, 2) & sn(j, 3) & "#~" & sn(j, 4) & ", " & sn(j, 5)
Next

End With

Filter alle elementen zonder tilde uit de Arraylist en wijs de resulterende array toe aan de eerste Listbox L_01.

L_01.List = Filter(.ToArray, "~", 0)

Filter achtereenvolgens alle sleutel-waarde-combinaties per sleutel.
Sla die als tekst op in de ArrayList 'al'.
De ArrayList 'al' bevat tenslotte alle keuzelijsten.

sp = Filter(.toarray, "~", 0)

For Each it In sp

sq = Filter(.toarray, it & "~")
al.Add Join(sq, "")
For Each it1 In sq

st = Filter(.toarray, Replace(it1, "~", "") & "|~")
al.Add Join(Filter(.toarray, Replace(it1, "~", "") & "|~"), "")
For Each it2 In st

al.Add Join(Filter(.toarray, Replace(it2, "|~", "") & "#~"), "")

De volledige code

Dim al

Private Sub UserForm_Initialize()

sn = Sheet2.ListObjects(1).DataBodyRange.Resize(, 5) Set al = CreateObject("System.Collections.ArrayList")
With CreateObject("System.Collections.ArrayList")

For j = 1 To UBound(sn)

Next

L_01.List = Filter(.toarray, "~", 0)

sp = Filter(.toarray, "~", 0)
For Each it In sp

sq = Filter(.toarray, it & "~")
al.Add Join(sq, "")
For Each it1 In sq

st = Filter(.toarray, Replace(it1, "~", "") & "|~")
al.Add Join(Filter(.toarray, Replace(it1, "~", "") & "|~"), "")
For Each it2 In st

al.Add Join(Filter(.toarray, Replace(it2, "|~", "") & "#~"), "")

End With

End Sub

Private Sub L_01_Change()

M_list 1

End Sub

De code in macro 'M_list'

Maak de volgende, afhankelijke keuzelijsten leeg

For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1
Me("L_0" & j).Clear

Wijs het ArrayList-item met de keuzelijst toe aan de volgende keuzelijst

Uit de Arraylist 'al' kan via de eigenschap .ToArray het item met de keuzelijstsleutel gefilterd worden.
Het filtercriterium 'c00' bestaat uit alle reeds gemaakte keuzen plus het voor de kolom kenmerkende teken.
Het gefilterde item bestaat uit een tekst van sleutels en waarden.
Splits die tekst in een array met alleen de waarden.
Wijs deze array toe aan de volgende ListBox
Selekteer het eerste item als de lijst slechts 1 item bevat.

c00 = L_01 & L_02 & L_03 & Trim(Mid(" |#", y, 1)) & "~"
With Me("L_0" & y + 1)

.List = Filter(Split("^" & Filter(al.toarray, c00)(0), c00), "^", 0)
If .ListCount = 1 Then .ListIndex = 0

End With

De volledige code

Sub M_list(y)

If Me("L_0" & y).ListIndex = -1 Then Exit Sub

For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1
Me("L_0" & j).Clear

Next

c00 = L_01 & L_02 & L_03 & Trim(Mid(" |#", y, 1)) & "~"

With Me("L_0" & y + 1)

.List = Filter(Split("^" & Filter(al.toarray, c00)(0), c00), "^", 0)
If .ListCount = 1 Then .ListIndex = 0

End With

End Sub

2.10.3 ArrayList met gebeurtenisklasse

De code bevindt zich in Userform 'U_arraylist_class' en de klassemodule 'C_arraylist'

Voor iedere ListBox in het Userform kun je gebruik maken van een klassemodule.
Daarin staat de code die bij een bepaalde aktie wordt uitgevoerd.
Daarvoor moet je iedere ListBox toewijzen aan een aparte instantie van de klassemodule.
Die afzonderlijke instanties bewaar je in een Object-variabele die een verzameling kan bevatten.
Dat kan bijv. een Array, een Dictionary of een Collection zijn.
In het voorbeeldbestand gebruiken we een Array.

De code in Userform 'U_arraylist_class'

Dim sc(2) As New C_arraylist

Wijs in de Initialize-procedure van het Userform iedere ListBox (L_01, L_02,L_03) toe aan objectvariabele 'c_list' in klassemodule C_arraylist'.
Door de koppeling met de klassemodule start een keuze in een Listbox de code in de klassemodule 'C_arraylist'.

For j = 0 To UBound(sc)

Set sc(j).c_list = Me("L_0" & j + 1)

Aktiveer de klassemodule om de eerste keuzelijst te genereren

L_01 = True

De volledige code

Dim sc(2) As New C_arraylist

Private Sub UserForm_Initialize()

For j = 0 To UBound(sc)

Set sc(j).c_list = Me("L_0" & j + 1)

Next

L_01 = True

End Sub

De code in klassemodule 'C_arraylist'

Het declaratiedeel bevat de declaratie als UserformListBox van object-variabele 'c_list'.
De object-variabele wordt geaktiveerd als gebeurteniscode (WithEvents).

Public WithEvents c_list As MSForms.ListBox

De variabele 'sn' is bedoeld om de databasegegevens in te lezen.
De variabele 'sn' wordt 'Private' gedeclareerd.
Daardoor hoeft de database slechts 1 keer ingelezen te worden en is dan gedurende het hele projekt in de klassemodule beschikbaar.

Voor de gebeurtenis 'Change' is een procedure opgenomen.
De Objectvariabele 'c_list' verwijst naar de gewijzigde Listbox uit het Userform.
Aan de hand van de naam wordt het nummer (y) van de Listbox bepaald.

Private Sub c_list_change()

If c_list.ListCount > 0 And c_list.ListIndex = -1 Then Exit Sub

If IsEmpty(sn) Then sn = Sheet2.ListObjects(1).DataBodyRange.Resize(, 5)

y = Val(Right(c_list.Name, 1)) + (c_list.ListCount = 0)

With c_list.Parent.Parent

For j = y + 1 To 4

.Controls("L_0" & j).ListIndex = -1
.Controls("L_0" & j).Clear

End With

Genereer keuzelijst

De zoeksleutel voor de ArrayList items voor de vervolgkeuzelijst wordt samengesteld op basis van reeds gemaakte keuzen:

c00 = .L_01 & .L_02 & .L_03

Alle records van de database worden doorlopen en gecontroleerd of ze overeenstemmen met de zoeksleutel c00.
Als dat het geval is en het item nog niet in de Arraylist voorkomt, wordt het eerstvolgende 'veld'/kolom aan de ArrayList toegevoegd.
De resulterende Arraylist bevat louter unieke waarden.
Deze worden met de eigenschap .ToArray ingelezen in de array 'sp'.

With CreateObject("System.collections.Arraylist")

For j = 1 To UBound(sn)

st = Array(True, sn(j, 1) = c00, sn(j, 1) & sn(j, 2) = c00, sn(j, 1) & sn(j, 2) & sn(j, 3) = c00)
If st(y) Then If Not .contains(sn(j, y + 1) & IIf(y = 3, ", " & sn(j, y + 2), "")) Then .Add sn(j, y + 1) & IIf(y = 3, ", " & sn(j, y + 2), "")
If .Count > 0 And st(y) = False Then Exit For

Next sp = .toarray

End With

Toewijzen keuzelijst aan volgende ListBox

De arrayvariabele 'sp' wordt toegewezen aan de volgende keuzelijst in het Userform.
Als deze keuzelijst slechts 1 item bevat, wordt dat item geselecteerd.

With .Controls("L_0" & y + 1)

.List = sp
If .ListCount = 1 Then .ListIndex = 0

End With

De volledige code

Private Sub c_list_change()

For j = y + 1 To 4

.Controls("L_0" & j).ListIndex = -1
.Controls("L_0" & j).Clear

Next

c00 = .L_01 & .L_02 & .L_03
With CreateObject("System.collections.Arraylist")

For j = 1 To UBound(sn)

Next
sp = .toarray

End With

With .Controls("L_0" & y + 1)

.List = sp If .ListCount = 1 Then .ListIndex = 0

End With

End Sub

2.11 Sortedlist

De SortedList-bibliotheek is een aparte VBA-bibliotheek en kun je gebruiken in alle Office-programma's.
Die bibliotheek maak je actief met de ('late binding') instruktie:

With CreateObject("System.Collections.Sortedlist")

end with

De SortedList maakt gebruik van sleutels.
Een sleutel kan slechts 1 keer in een SortedList voorkomen.
De SortedList heeft een ingebouwde methode om te controleren of de Sortedlist een bepaald item al bevat. .indexofkey
De SortedList heeft een ingebouwde sorteermethode.
De inhoud van de SortedList moet via een loop uitgelezen worden.

2.11.1 SortedList: filter achteraf

De code van het Userform 'U_SortedList'

Om de interaktie met de Excel-applicatie tot een minimum te beperken lezen we de tabelgegevens alleen in de Userform_initialize procedure in.
Die tabelgegevens worden opgeslagen in de Array 'sn'"
Omdat we deze variabele pas in de gemeenschappelijke macro 'M_list' gaan gebruiken declareren we variabele 'sn' als Private. Daardoor is de variabele toegankelijk in alle procedures in het Userform.
De SortedList gebruiken we in macro 'M_list' om de elementen van een keuzelijsten te bewaren.

De code van Userform_Initialize

Declareer de variabele 'sn'.
Lees de databasetabel in in variabele 'sn'.
Roep de Macro 'M_list' aan om de eerste keuzelijst te genereren.
Geef het argument 0 door om de soort keuzelijst te bepalen.

Private Sub UserForm_Initialize()

sn = Sheet2.ListObjects(1).DataBodyRange.Resize(, 5)

M_list 0

End Sub

Private Sub L_01_Change()

M_list 1

End Sub

De code van macro 'M_list'

Maak alle volgende keuzelijsten leeg

For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1
Me("L_0" & j).Clear

Genereer de volgende keuzelijst

Filter uit de database alle records die voldoen aan een criterium.
Het criterium is de combinatie van lijstkeuzes in variabele c00.
Het resultaat van de criteriumcheck per kolom komt in variabele 'st'.
Als het record aan het criterium vodoen wordt het gegeven in de volgende kolom als sleutel opgenomen in de SortedList.
Om dubbele items te voorkomen wordt gecheckt met .IndexofKey of de arraylist de sleutel al bevat.
De items in de SortedList zijn automatisch alfabetisch gesorteerd.

c00 = L_01 & L_02 & L_03

With CreateObject("system.collections.Sortedlist")

For j = 1 To UBound(sn)

c01 = sn(j, y + 1) & IIf(y = 3, ", " & sn(j, y + 2), "")

st = Array(True, sn(j, 1) = c00, sn(j, 1) & sn(j, 2) = c00, sn(j, 1) & sn(j, 2) & sn(j, 3) = c00)
If st(y) And .IndexofKey(c01) = -1 Then .Add c01, ""
If .Count > 0 And st(y) = False Then Exit For

End With

Zet de keuzelijst in een array en wijs toe aan de volgende ListBox

Declareer array 'sp' ter grootte van het aantal sleutels in de SorteedList.
Zet de Sortedlist sleutels in de array.
Wijs de array 'sp tot aan de volgende ListBox.
Als de Listbox slechts 1 item bevat, selecteer het dan.

ReDim sp(.Count - 1)
For j = 0 To UBound(sp)

sp(j) = .getkey(j)

Next

With Me("L_0" & y + 1)

.List = sp
.ListIndex = .ListCount > 1

End With

De volledige code

Sub M_list(y)

If y > 0 Then If Me("L_0" & y).ListIndex = -1 Then Exit Sub

For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1
Me("L_0" & j).Clear

Next

c00 = L_01 & L_02 & L_03
With CreateObject("system.collections.Sortedlist")

For j = 1 To UBound(sn)

c01 = sn(j, y + 1) & IIf(y = 3, ", " & sn(j, y + 2), "")

st = Array(True, sn(j, 1) = c00, sn(j, 1) & sn(j, 2) = c00, sn(j, 1) & sn(j, 2) & sn(j, 3) = c00)
If st(y) And .indexofkey(c01) = -1 Then .Add c01, ""
If .Count > 0 And st(y) = False Then Exit For

Next

ReDim sp(.Count - 1)
For j = 0 To UBound(sp)

sp(j) = .getkey(j)

End With

With Me("L_0" & y + 1)

.List = sp
.ListIndex = .ListCount > 1

End With

End Sub

2.11.2 SortedList: filter vooraf

De code in Userform 'U_SortedList_002'

In het declaratiedeel van de codemodule is een Private variabele gedeclareerd met de naam 'sl'.
Deze variabele is toegankelijk in alle procedures van het Userform.
De code in Userform_Initialize procedure wijst er een sortedlist aan toe.

Dim al

In de Initialize procedure gebruiken we 2 SortedLists.
De eerste is 'Local' voor de inventarisatie van alle 3375 sleutel/waarde-combinaties.
De tweede is 'Private' en wordt toegewezen aan variabele 'sl'.
In deze tweede SortedList komen alle 211 keuzelijsten terecht. Inventariseer alle sleutel-waarde combinaties

Lees de databasetabel in in Array 'sn'.
Wijs een nieuwe Sortedlist-instantie toe aan variabele 'sl'.

sn = Sheet2.ListObjects(1).DataBodyRange.Resize(,5)

Set sl = CreateObject("System.Collections.SortedList")

Maak een nieuwe Local SortedList.
Loop door alle records van de database.
Stel per record aan de hand van de waarden in de eerste 5 kolommen de elementen van de keuzelijsten samen.
Controleer of dat element al in de SortedList staat.
Zo niet, voeg het als sleutel toe aan de SortedList.
Deze SortedList sleutels bestaan dan uit louter unieke elementen voor keuzelijsten.

With CreateObject("system.collections.sortedlist")

For j = 1 To UBound(sn)

If .indexofkey("Stadt~" & sn(j, 1)) = -1 Then .Add "Stadt~" & sn(j, 1), ""
If .indexofkey(sn(j, 1) & "~" & sn(j, 2)) = -1 Then .Add sn(j, 1) & "~" & sn(j, 2), ""
If .indexofkey(sn(j, 1) & sn(j, 2) & "~" & sn(j, 3)) = -1 Then .Add sn(j, 1) & sn(j, 2) & "~" & sn(j, 3), ""
If .indexofkey(sn(j, 1) & sn(j, 2) & sn(j, 3) & "~" & sn(j, 4) & ", " & sn(j, 5)) = -1 Then .Add sn(j, 1) & sn(j, 2) & sn(j, 3) & "~" & sn(j, 4) & ", " & sn(j, 5), ""

End With

Filter alle elementen zonder tilde uit de SortedList en wijs de resulterende array toe aan de eerste Listbox L_01.

L_01.List = Filter(.ToArray, "~", 0)

Doorloop alle sleutel-waarde-combinaties in de tijdelijke SortedList.
Splits de sleutel/waarde combinatie in sleutel en waarde afzonderlijk in variabele 'st'.
Converteer de elementen van array 'st' met 'Trim()' in een tekenreeks; dan worden ze door de SortedList geaccepteerd. Sla de waarden per sleutel op in SortedList 'sl'.
De SortedList 'sl' bevat tenslotte alle keuzelijsten.
Iedere keuzelijst is met de sleutel op te roepen.
Roep het item met de sleutel 'Stadt' op, splits de string en wijs toe aan de eerste Listbox L_01.

For j = 0 To .Count - 1

st = Split(.getkey(j), "~") If sl.indexofkey(Trim(st(0))) = -1 Then

sl.Add Trim(st(0)), Trim(st(1))

Else

sl(Trim(st(0))) = sl(Trim(st(0))) & "|" & Trim(st(1))

End If

L_01.List = Split(sl("Stadt"), "|")

De volledige code

Dim sl

Private Sub UserForm_Initialize()

sn = Sheet2.ListObjects(1).DataBodyRange.Resize(, 5)

Set sl = CreateObject("system.collections.sortedlist")
With CreateObject("system.collections.sortedlist")

For j = 1 To UBound(sn)

Next

For j = 0 To .Count - 1

st = Split(.getkey(j), "~")
If sl.indexofkey(Trim(st(0))) = -1 Then

sl.Add Trim(st(0)), Trim(st(1))

Else

sl(Trim(st(0))) = sl(Trim(st(0))) & "|" & Trim(st(1))

End If

End With L_01.List = Split(sl("Stadt"), "|")

End Sub

Private Sub L_01_Change()

M_list 1

End Sub

De code in macro 'M_list'

Maak de volgende, afhankelijke keuzelijsten leeg

For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1
Me("L_0" & j).Clear

Wijs het SortedList-item met de keuzelijst toe aan de volgende keuzelijst

Dankzij de sleutels in de SortedList 'sl' kan de keuzelijst opgehaald worden.
De lsutel bestaat uit de samenvoeging van gemaakte keuzes in ListBoxen.
De waarden van de keuzelijst staan er als tekstreeks en moeten eerst nog gesplitst worden om toe te wijzen aan de de volgende ListBox.
Als de ListBox slechts 1 item bevat wordt dat geselekteerd.

With Me("L_0" & y + 1)

.List = Split(sl(L_01 & L_02 & L_03), "|")
If .ListCount = 1 Then .ListIndex = 0

End With

De volledige code

Sub M_list(y)

If Me("L_0" & y).ListIndex = -1 Then Exit Sub

For j = y + 1 To 4

Me("L_0" & j).ListIndex = -1
Me("L_0" & j).Clear

Next

With Me("L_0" & y + 1)

.List = Split(sl(L_01 & L_02 & L_03), "|")
If .ListCount = 1 Then .ListIndex = 0

End With

End Sub

2.11.3 SortedList met gebeurtenisklasse

De code bevindt zich in Userform 'U_sortedlist_class' en de klassemodule 'C_sortedlist'

Voor iedere ListBox in het Userform kun je gebruik maken van een klassemodule.
Daarin staat de code die bij een bepaalde aktie wordt uitgevoerd.
Daarvoor moet je iedere ListBox toewijzen aan een aparte instantie van de klassemodule.
Die afzonderlijke instanties bewaar je in een Object-variabele die een verzameling kan bevatten.
Dat kan bijv. een Array, een Dictionary of een Collection zijn.
In het voorbeeldbestand gebruiken we een Array.

De code in Userform 'U_SortedList_class'

Dim sc(2) As New C_sortedlist

Wijs in de Initialize-procedure van het Userform iedere ListBox (L_01, L_02,L_03) toe aan objectvariabele 'c_list' in klassemodule C_sortedlist'.
Door de koppeling met de klassemodule start een keuze in een Listbox de code in de klassemodule 'C_sortedlist'.

For j = 0 To UBound(sc)

Set sc(j).c_list = Me("L_0" & j + 1)

Aktiveer de klassemodule om de eerste keuzelijst te genereren

L_01 = True

De volledige code

Dim sc(2) As New C_sortedlist

Private Sub UserForm_Initialize()

For j = 0 To UBound(sc)

Set sc(j).c_list = Me("L_0" & j + 1)

Next

L_01 = True

End Sub

De code in klassemodule 'C_sortedlist'

Het declaratiedeel bevat de declaratie als UserformListBox van object-variabele 'c_list'.
De object-variabele wordt geaktiveerd als gebeurteniscode (WithEvents).

Public WithEvents c_list As MSForms.ListBox

De variabele 'sn' is bedoeld om de databasegegevens in te lezen.
De variabele 'sn' wordt 'Private' gedeclareerd.
Daardoor hoeft de database slechts 1 keer ingelezen te worden en is dan gedurende het hele projekt in de klassemodule beschikbaar.

Voor de gebeurtenis 'Change' is een procedure opgenomen.
De Objectvariabele 'c_list' verwijst naar de gewijzigde ListBox uit het Userform.
Aan de hand van de naam wordt het nummer (y) van de ListBox bepaald.

Private Sub c_list_change()

If c_list.ListCount > 0 And c_list.ListIndex = -1 Then Exit Sub

If IsEmpty(sn) Then sn = Sheet2.ListObjects(1).DataBodyRange.Resize(, 5)

y = Val(Right(c_list.Name, 1)) + (c_list.ListCount = 0)

With c_list.Parent.Parent

For j = y + 1 To 4

.Controls("L_0" & j).ListIndex = -1
.Controls("L_0" & j).Clear

End With

Genereer keuzelijst

De zoeksleutel voor de SortedList items voor de vervolgkeuzelijst wordt samengesteld op basis van reeds gemaakte keuzen:

c00 = .L_01 & .L_02 & .L_03

Alle records van de database worden doorlopen en gecontroleerd of ze overeenstemmen met de zoeksleutel c00.
Als dat het geval is en het item nog niet in de SortedList voorkomt, wordt het eerstvolgende 'veld'/kolom als sleutel aan de SortedList toegevoegd.
De resulterende SortedList bevat louter unieke waarden.

With CreateObject("System.collections.SortedList")

For j = 1 To UBound(sn)

st = Array(True, sn(j, 1) = c00, sn(j, 1) & sn(j, 2) = c00, sn(j, 1) & sn(j, 2) & sn(j, 3) = c00)
If st(y) And .IndexofKey(c01) = -1 Then .Add c01, ""
If .Count > 0 And st(y) = False Then Exit For

End With

Alle sleutels van de SortedList worden in een Array-variabele 'sp gezet.

ReDim sp(.Count - 1) For j = 0 To UBound(sp)

sp(j) = .getkey(j)

Toewijzen keuzelijst aan volgende ListBox

De arrayvariabele 'sp' wordt toegewezen aan de volgende keuzelijst in het Userform.
Als deze keuzelijst slechts 1 item bevat, wordt dat item geselecteerd.

With .Controls("L_0" & y + 1)

.List = sp
If .ListCount = 1 Then .ListIndex = 0

End With

De volledige code

Dim sn
Public WithEvents c_list As MSForms.ListBox

Private Sub c_list_change()

For j = y + 1 To 4

.Controls("L_0" & j).ListIndex = -1
.Controls("L_0" & j).Clear

Next

c00 = .L_01 & .L_02 & .L_03
With CreateObject("System.collections.sortedlist")

For j = 1 To UBound(sn)

Next

ReDim sp(.Count - 1)
For j = 0 To UBound(sp)

sp(j) = .getkey(j)

End With

With .Controls("L_0" & y + 1)

.List = sp
If .ListCount = 1 Then .ListIndex = 0

End With

End Sub