Code voor filteren combobox op userform tijdens typen

[SjonR]

Ik heb gegoogeld en alle gevonden code geprobeerd, maar kan niets vinden dat werkt.

Is er een standaard code om de vulling van een combobox te filteren als je iets intikt?

Mijn combobox wordt hiermee gevuld.

ComboBox9.List = Blad1.ListObjects(1).DataBodyRange.Value

Gr.

Sjon

 

[HSV]

Is geen code voor nodig, werkt standaard prima.

 

[SjonR]

Maar het probleem waar ik mee zit is dat er meerdere gelijke waarden in de list voorkomen en dan moet ik toch nog scrollen om de juiste te vinden. Combobox heeft meerdere kolommen.

Het zou mooi zijn als ik dan alleen de waarden zie die matchen met wat ik heb ingetikt.

 

[HSV]

Helaas zie ik geen probleem; plaats een bestandje met wat de bedoeling is.

 

[SjonR]

Bekijk bijlage voorbeeldfilterCbox.xlsm

Inderdaad is een bestandje wel handig. In het voorbeeld staan niet zoveel nummers, maar in het daadwerkelijke bestand komen duizenden nummers die niet gesorteerd staan op nummer. Daar zitten dubbele waarden in, maar de datum in kolom B verschilt.

Als ik dus nummer 9500 in zou tikken, zou ik alle rijen met 9500 willen terugvinden in mijn combobox.

 

[HSV]

Het kan bv. met advanced filter naar een ander blad of met onderstaande.

Niet twee keer na elkaar te gebruiken bij verandering van textbox.

Private Sub TextBox1_AfterUpdate()
  For i = ComboBox1.ListCount - 1 To 0 Step -1
     If ComboBox1.List(i) <> Val(TextBox1) Then ComboBox1.RemoveItem i
  Next
End Sub

Of voor meerdere keren.

Private Sub TextBox1_AfterUpdate()
sn = Blad1.ListObjects(1).DataBodyRange
ReDim arr(UBound(sn, 2), 0)
 For i = 1 To UBound(sn)
   If sn(i, 1) = Val(TextBox1) Then
     For j = 1 To UBound(sn, 2)
       arr(j - 1, UBound(arr, 2)) = sn(i, j)
     Next j
    ReDim Preserve arr(UBound(sn, 2), UBound(arr, 2) + 1)
   End If
 Next i
ReDim Preserve arr(UBound(sn, 2), UBound(arr, 2) - 1)
ComboBox1.List = Application.Transpose(arr)
End Sub

Of misschien beter.

Private Sub TextBox1_AfterUpdate()
sn = Blad1.ListObjects(1).DataBodyRange
ReDim arr(Application.CountIf(Blad1.ListObjects(1).DataBodyRange.Columns(1), Val(TextBox1)) - 1, 2)
    For i = 1 To UBound(sn)
     If LCase(sn(i, 1)) = Val(TextBox1) Then
      For j = 0 To UBound(sn, 2) - 1
        arr(x, j) = sn(i, j + 1)
       Next j
        x = x + 1
      End If
     Next i
ComboBox1.List = arr
End Sub

 

[SjonR]

Als ik deze code in mijn userform plaats zie ik niets gebeuren Harry. Kan je me uitleggen wat de derde code zou moeten doen. Ik snap niet waarom de code over textbox1 gaat. Daar zou een opmerking in moeten komen die los staat van de combobox1.

 

[HSV]

Het zou mooi zijn als ik dan alleen de waarden zie die matchen met wat ik heb ingetikt.

Ik dacht dat je het wilde intikken in de textbox.

 

[SjonR]

Ik bedoelde in de combobox, maar als het met een textbox ook zo lukt, is het ook prachtig.

Ik ben er blij mee.

Enorm bedankt.

 

[HSV]

Neu,

Hier de code voor het intikken in de combo.

Private Sub ComboBox1_DropButtonClick()
sn = Blad1.ListObjects(1).DataBodyRange
If ComboBox1 <> "" Then
ReDim arr(Application.CountIf(Blad1.ListObjects(1).DataBodyRange.Columns(1), Val(ComboBox1)) - 1, 2)
    For i = 1 To UBound(sn)
     If LCase(sn(i, 1)) = Val(ComboBox1) Then
       For j = 0 To UBound(sn, 2) - 1
        arr(x, j) = sn(i, j + 1)
       Next j
        x = x + 1
      End If
     Next i
ComboBox1.List = arr
End If
End Sub

Of:

Private Sub ComboBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)

....en dan gebruik je de Tabtoets na het invullen van een getal.

 

[SjonR]

Nog beter. Ik gahet morgen testen

 

[SjonR]

Bekijk bijlage voorbeeldfilterCbox.xlsm

Het filteren werkt nu prachtig in de combobox, exact zoals ik het voor ogen had. Nu werkt het wegschrijven van de opmerking naar kolom C echter niet meer.

Doe ik iets verkeerd?

 

[snb]

Nee, maar als je de inhoud van de combobox wijzigt, komt de listindex niet meer overeen met de tabelgegevens.

Private Sub UserForm_Initialize()
  ComboBox1.List = Blad1.ListObjects(1).DataBodyRange.Value
  ComboBox2.List = ComboBox1.List
End Sub

Private Sub ComboBox1_change()
  sn = ComboBox2.List
    
  If ComboBox1 <> "" Then
    For j = 0 To UBound(sn)
      If LCase(Left(sn(j, 0), Len(ComboBox1))) = Format(ComboBox1) Then c00 = c00 & j + 1 & " "
    Next
          
    ComboBox1.List = Application.Index(sn, Application.Transpose(Split(c00)), Array(1, 2, 3))
    ComboBox1.Tag = c00
  End If
End Sub

Private Sub CommandButton1_Click()
  Blad1.ListObjects(1).DataBodyRange.Cells(Val(ComboBox1.Tag), 3) = TextBox1
End Sub

 

[SjonR]

Bedankt voor je bestand SNB,
Als ik een unieke waarde selecteer werkt het perfect, maar als ik bijvoorbeeld een regel met nummer 2 kies dan krijg ik een foutmelding "Fout 6 tijden uitvoering" met de tekst "Overloop".

Foutmelding is op Private Sub CommandButton1_Click()

Aan je voorbeeldbestand te zien had jij hier geen last van.

 

[snb]

is op te lossen met:

Private Sub ComboBox1_change()
    sn = ComboBox2.List
    
    If ComboBox1.ListIndex = -1 Then
         For j = 0 To UBound(sn)
             If LCase(Left(sn(j, 0), Len(ComboBox1))) = Format(ComboBox1) Then c00 = c00 & j + 1 & " "
         Next
          
        ComboBox1.List = Application.Index(sn, Application.Transpose(Split(c00)), Array(1, 2, 3))
        ComboBox1.Tag = c00
   End If
End Sub

 

[SjonR]

Met de aangepaste code krijg ik exact dezelfde foutmelding als bij #14 beschreven.

 

[snb]

Je moet natuurlijk wel een keuze uit de lijst met opties maken.

 

[SjonR]

Geweldig, nu werkt het bij alles.

Mijn dank is groot.

Gr.

Sjon

 

[SjonR]

Als ik de code in mijn bestand heb geplaatst start het formulier niet op omdat hij combobox2 mist. In het voorbeeldbestand van SNB staat echter ook geen Combobox2 op het formulier, maar daar treedt het probleem niet op.

ALs ik de regel Combobox2.List = Combobox1.List ( SUB Userform_ Initialize) onklaar maak, dan start ie wel op.

Iemand enig idee hoe dit kan?

 

[VenA]

Maak het formulier van snb eens wat breder