Afhankelijke combobox met apart filter

Status
Niet open voor verdere reacties.

CamJacobus

Verenigingslid
Lid geworden
29 mrt 2016
Berichten
58
Goedemorgen allen,

Ik heb de website van SNB goed bekeken hoe ik de werking van de afhankelijke combobox kan combineren met een gefilterde weergave in de volgende combobox. Helaas is dit bij mij niet gelukt om dit werkend te krijgen.

Ik laat nu met de volgende code op basis van de unieke nummers en een filtering op kolom 9 ("Status") de bijbehorende gegevens in de userform zien. Deze gegevens kunnen vervolgens gewijzigd opgeslagen worden in de tabel. Nu zou ik graag in eerste instantie met een keuze in een combobox een filter willen plaatsen op de keyuser, waarna die vervolgens de juiste nummers toont die daarbij horen met daarbij ook de filtering op kolom 9. Hoe krijg ik dat voor elkaar? Zie ook voorbeeldbestand!

Code:
Public Sub UserForm_Initialize()
    
    sn = Sheets("Invoer").Range("TB_Invoer[#Data]")
    
    With CreateObject("System.Collections.ArrayList")
        For j = 1 To UBound(sn)
          If Not .contains(sn(j, 10)) And sn(j, 9) <> "Afgewezen" And sn(j, 9) <> "Gepland" And sn(j, 9) <> "" Then .Add sn(j, 10)
        Next
        .Sort
        
        cboNummer.List = .toarray()
    End With
    
    With cboNummer
        For i = 0 To .ListCount - 1
            For j = i + 1 To .ListCount - 1
                If .List(i) > .List(j) Then
                    Temp = .List(j)
                    .List(j) = .List(i)
                    .List(i) = Temp
                End If
            Next j
        Next i
    End With
    
    DTPicker1.Value = Date
    cboKeyuser.List = Sheets("Pull Down").Range("TB_Keyuser").Value
    cboSoort.List = Sheets("Pull Down").Range("TB_Soort").Value
    
End Sub

Private Sub cboNummer_Change()
    Dim myTbl As Excel.ListObject
    Dim cntRow As Long, cntCol As Long
    Dim rngTbl As Range, rngCol As Range
    Dim rng1 As Range, rng2 As Range, rng3 As Range, rng4 As Range, rng5 As Range, rng6 As Range, rng7 As Range
    Dim i As Integer
'set parameters
    Set myTbl = ActiveSheet.ListObjects("TB_Invoer") 'tabel
    With myTbl
        cntRow = .ListRows.Count
        Set rngCol = Range(myTbl & "[Nummer]")
        Set rng1 = Range(myTbl & "[Naam Keyuser]")
        Set rng2 = Range(myTbl & "[Datum van invoer]")
        Set rng3 = Range(myTbl & "[Beschrijving]")
        Set rng4 = Range(myTbl & "[Toelichting]")
        Set rng5 = Range(myTbl & "[Nav tabel / Scherm]")
        Set rng6 = Range(myTbl & "[Soort]")
        Set rng7 = Range(myTbl & "[Prio 1 t/m 999]")

    End With
'find ColRow
    For i = 1 To cntRow
        If rngCol.Cells(i, 1) = Me.cboNummer.Value Then
            Me.cboKeyuser.Value = rng1.Cells(i, 1)
            Me.DTPicker1.Value = rng2.Cells(i, 1)
            Me.txtBeschrijving.Value = rng3.Cells(i, 1)
            Me.txtToelichting.Value = rng4.Cells(i, 1)
            Me.txtNAVtabel.Value = rng5.Cells(i, 1)
            Me.cboSoort.Value = rng6.Cells(i, 1)
            Me.txtPrio.Value = rng7.Cells(i, 1)
            On Error Resume Next
            Exit For
        End If
    Next i
End Sub

Alvast bedankt voor het meedenken! Groeten, Jaco
 

Bijlagen

  • Userform afhankelijke combobox met filtering.xlsm
    63,9 KB · Weergaven: 56
Mijn vraag is misschien toch niet helemaal helder. Hierbij nog een extra toelichting.

Met dit deel van de code laat ik in combobox cboNummer alleen de unieke nummers zien, waarbij de status uit kolom 9 (kolom I) niet op "Afgewezen" en "Gepland" staat.
Code:
Public Sub UserForm_Initialize()
    
    sn = Sheets("Invoer").Range("TB_Invoer[#Data]")
    
    With CreateObject("System.Collections.ArrayList")
        For j = 1 To UBound(sn)
          If Not .contains(sn(j, 10)) And sn(j, 9) <> "Afgewezen" And sn(j, 9) <> "Gepland" And sn(j, 9) <> "" Then .Add sn(j, 10)
        Next
        .Sort
        
        cboNummer.List = .toarray()
    End With
    
    With cboNummer
        For i = 0 To .ListCount - 1
            For j = i + 1 To .ListCount - 1
                If .List(i) > .List(j) Then
                    Temp = .List(j)
                    .List(j) = .List(i)
                    .List(i) = Temp
                End If
            Next j
        Next i
    End With
    
    DTPicker1.Value = Date
    cboKeyuser.List = Sheets("Pull Down").Range("TB_Keyuser").Value
    cboSoort.List = Sheets("Pull Down").Range("TB_Soort").Value
    
End Sub

Nu wil ik dat de weergave van de nummers ook nog beperkt wordt door de ingevulde waarde van de combobox cboKeyuser. De waarde hiervan staat in kolom 1. Het is geen oplossing om de code te wijzigen in:
Code:
Public Sub UserForm_Initialize()
    
    sn = Sheets("Invoer").Range("TB_Invoer[#Data]")
    
    With CreateObject("System.Collections.ArrayList")
        For j = 1 To UBound(sn)
          If Not .contains(sn(j, 10)) And sn(j, 9) <> "Afgewezen" And sn(j, 9) <> "Gepland" And sn(j,1) = cboKeyuser And sn(j, 9) <> "" Then .Add sn(j, 10)
        Next
        .Sort
        
        cboNummer.List = .toarray()
    End With
    
    With cboNummer
        For i = 0 To .ListCount - 1
            For j = i + 1 To .ListCount - 1
                If .List(i) > .List(j) Then
                    Temp = .List(j)
                    .List(j) = .List(i)
                    .List(i) = Temp
                End If
            Next j
        Next i
    End With
    
    DTPicker1.Value = Date
    cboKeyuser.List = Sheets("Pull Down").Range("TB_Keyuser").Value
    cboSoort.List = Sheets("Pull Down").Range("TB_Soort").Value
    
End Sub

Hopelijk is de vraag nu iets duidelijker. :rolleyes:
 
Is er iemand die mij een stap op de goede weg kan brengen?

Alvast bedankt!
 
een gokje
- nieuwe macro "Private Sub cboKeyuser_Change()" als je een andere keyuser selecteert.
- je sorted list kijkt nu of je al een keyuser hebt of niet
- die 2e sortering in een loop lijkt me overbodig
-kijken of je nog geen keyuser geselecteerd hebt om desnoods die lijst aan te passen


Code:
[COLOR="#FF0000"]Private Sub cboKeyuser_Change()
   UserForm_Initialize
End Sub[/COLOR]

Public Sub UserForm_Initialize()

   sn = Sheets("Invoer").Range("TB_Invoer[#Data]")

   With CreateObject("System.Collections.ArrayList")
      For j = 1 To UBound(sn)
         If Not .contains(sn(j, 10)) And sn(j, 9) <> "Afgewezen" And sn(j, 9) <> "Gepland" And sn(j, 9) <> "" [COLOR="#FF0000"]And (sn(j, 1) = cboKeyuser.Value Or cboKeyuser.Value = "")[/COLOR] Then .Add sn(j, 10)
      Next
      .Sort

      cboNummer.List = .toarray()

      xx = .toarray()
   End With

   With cboNummer                                'overbodig ?????
     [COLOR="#FF0000"][COLOR="#008000"] For i = 0 To .ListCount - 1
         For j = i + 1 To .ListCount - 1
            If .List(i) > .List(j) Then
               Temp = .List(j)
               .List(j) = .List(i)
               .List(i) = Temp
            End If
         Next j
      Next i
   End With
[/COLOR][/COLOR]
   
DTPicker1.Value = Date
  [COLOR="#FF0000"] If cboKeyuser.Value = "" Then[/COLOR] cboKeyuser.List = Sheets("Pull Down").Range("TB_Keyuser").Value
   cboSoort.List = Sheets("Pull Down").Range("TB_Soort").Value

End Sub
 
Laatst bewerkt:
Super bedankt! De truc was dus uiteindelijk de _Change actie voor cboKeyuser opnieuw in te richten. De tweede loop lijkt inderdaad geen toegevoegde waarde te geven.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan