Combobox 2 afhankelijk van combobox 1

[wally1968]

Bekijk bijlage Combobox.xls

Hallo iedereen

Ik heb een bestandje ingevoegd met een userform met 2 Comboboxen.
De bedoeling is dat combox 2 afhankelijk is van de keuze van combobox 1
Dank bij voorbaat

 

[mcs51mc]

Voor combobox 1 maak je een lijst "lstCB1" in de sheet. Bij starten form laad je al die items in de combo 1.

Voor elke item van combo1 maak je een lijst "lstCB2CB1x" in de sheet, x staat voor elke item van combo 1. Bij wijzigen van combo 1 pas je de itmes in combo 2 aan.

Een lijst een naam geven doe je via Invoegen\Naam\Definiëren in het menu.

Duidelijk? Pas je xls file aan en laat ons weten hoe ver je komt, we kunnen dan bijsturen... ...

 

[wally1968]

Sorry maar dit is echt chinees voor mij
De namen de Definiëren had ik normaal al gedaan
Van de rest snap ik echt niet wat je bedoeld

 

[HSV]

Misschien leest dit gemakkelijker. :d
In Userformmodule:

Sub Locate(Name As String, Data As Range)
X = 2
    Dim rngFind As Range
    Dim strFirstFind As String
     With Data
        Set rngFind = .Find(Name, LookIn:=xlValues, LookAt:=xlPart)
        If Not rngFind Is Nothing Then
            strFirstFind = rngFind.Address
            Do
                If rngFind.Row > 1 Then
                   Me("ComboBox" & X).AddItem rngFind.Offset(, 1).Value
            End If
                Set rngFind = .FindNext(rngFind)
            Loop While Not rngFind Is Nothing And rngFind.Address <> strFirstFind
        End If
    End With
 End Sub


Private Sub UserForm_Activate()
Dim I As Integer
Dim searchfor As String
I = 2
    searchfor = ComboBox1.Value
Do Until Sheets("Blad1").Cells(I, 1).Value = Empty
    ComboBox1.AddItem Sheets("Blad1").Cells(I, 1).Value
    I = I + 1
     Loop
    For I = ComboBox1.ListCount - 1 To 1 Step -1
     If ComboBox1.List(I) = ComboBox1.List(I - 1) Then ComboBox1.RemoveItem (I)
   Next
End Sub
Private Sub Combobox1_Change()
     ComboBox2.Clear
        Locate ComboBox1.Value, Sheets("Blad1").Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
End Sub

 

[wally1968]

Mijn dank is groot

 

[mcs51mc]

Alle wegen leiden naar Rome
Met "lstCB1" een lijst in de sheet met alle items voor combo1 (vb A1 tem Ax)
Met "lstCB2CB101" een lijst in de sheet met alle items voor combo2 bij selectie van item 1 in combo 1 (vb B1 tem Bx)
Met "lstCB2CB102" een lijst in de sheet met alle items voor combo2 bij selectie van item 2 in combo 1 (vb C1 tem Cx)
Met "lstCB2CB103" een lijst in de sheet met alle items voor combo2 bij selectie van item 3 in combo 1 (vb D1 tem Dx)

Private Sub cmb1_Change()
Dim rngCell     As Range
Dim strDummy    As String

    'Opbouw control name
    strDummy = "lstCB2CB10" & CStr(Me.cmb1.ListIndex + 1)
    
    'Combo 2 wissen en nieuwe items in combo 2
    Me.cmb2.Clear
    For Each rngCell In ActiveSheet.Range(strDummy)
        Me.cmb2.AddItem rngCell.Value
    Next rngCell
    Me.cmb2.ListIndex = 0
    
    
End Sub


Private Sub UserForm_Activate()
Dim rngCell    As Range

    'Opvullen combo 1 en item 1 selecteren
    For Each rngCell In ActiveSheet.Range("lstCB1")
        Me.cmb1.AddItem rngCell.Value
    Next rngCell
    Me.cmb1.ListIndex = 0
    
    'Opvullen combo 2 met eerste lijst
    For Each rngCell In ActiveSheet.Range("lstCB2CB101")
        Me.cmb2.AddItem rngCell.Value
    Next rngCell
    Me.cmb2.ListIndex = 0
    
End Sub

Merk op dat die code verre van "fool proof" is :shocked:
Dat laat ik aan jouw over
Wanneer dit nog steeds Chinees is, dan zal je Chinees moeten leren