Listbox zoeken met 1 textbox

[whiskey0010]

Goedemiddag allemaal,

Ik ben al tijdje aan het rommelen met een scripje voor het zoeken met 1 textbox in alle gegevens die in listbox1 staan.

Wat ik wil is dat in Listbox1 alle gegevens komen uit sheet1 (in mijn geval zijn dat gegevens uit kolom A t/m H).
Als ik dan iets in textbox1 typ moeten al deze regels worden gefilterd en alleen de regels met de overeengekomen waarde worden weergegeven.

Na verschillende scripts al te hebben gevonden krijg ik het toch niet voor elkaar iets in elkaar te steken dat werkt.

Wie wil/kan mij hiermee helpen.

Bekijk bijlage listboxzoeken_textbox.xls

 

[Ginger]

En waarom filter je niet simpelweg je sheet? Dit kan met het Autofilter of het Advanced Filter. Wat voor "plus" heeft het overhalen van gegevens in een Listbox?

 

[whiskey0010]

Omdat de hele sheet via vba gaat lopen. Het werkblad word straks in zijn geheel verborgen en is dan niet meer zichtbaar.

Dit is een vb van wat ik wil. Alleen moet je bij deze code voor ieder kolom in een aparte textbox zoeken.

Public filfin As Long
 
Private Sub UserForm_Initialize()
 
Sheets("SHEET1").Select
With Worksheets("SHEET1")
Me.ListBox1.Clear
If .FilterMode Then .ShowAllData
filfin = Range("A65536").End(xlUp).Row
Me.ListBox1.List = Range("b2:H" & filfin).Value
Me.TextBox1.SetFocus
 
End With
End Sub
 
 
Private Sub FilterList(iCtrl As Long, sText As String)
Dim iRow As Long
Dim sCrit As String
sCrit = "*" & UCase(sText) & "*"
With Me.ListBox1
 
filfin = Range("A65536").End(xlUp).Row
.List = Range("b2:H" & filfin).Value
 
For iRow = .ListCount - 1 To 0 Step -1
If Not UCase(.List(iRow, iCtrl)) Like sCrit Then
.RemoveItem iRow
End If
Next iRow
End With
End Sub
 
 
Private Sub TextBox1_Change()
FilterList 0, Me.TextBox1.Text
End Sub
 
'Private Sub TextBox2_Change()
'FilterList 1, Me.TextBox2.Text
'End Sub

 

[VenA]

Heb je er ook een excelbestandje bij? En werk je nog met Xl-2003?

 

[Ginger]

Dus je zoekwaarde kan werkelijk in elke kolom voor komen? Tja, dan zou ik waarschijnlijk de tabel voorzien van een extra kolom waar je met een TRUE of FALSE aangeeft of je zoekwaarde er in staat.

 

[gast0660]

Filter listbox en sheet

Private Sub TextBox1_Change()
Str = TextBox1.Text
If Not Str = "" Then
    With ListBox1
        For i = .ListCount - 1 To 0 Step -1
            If InStr(1, LCase(.List(i, [COLOR="#FF0000"]0[/COLOR])), LCase(Str)) = 0 Then
            .RemoveItem i
            End If
        Next i
    End With
End If
With Sheets("Sheet1").Range("B2:H" & Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row)
  If .Parent.AutoFilterMode Then .Parent.AutoFilterMode = False
    .AutoFilter [COLOR="#FF0000"]1[/COLOR], TextBox1.Text
End With
End Sub

De rode 0 is de eerste kolom in uw listBox, en de rode 1 is kolom A in uw sheet (daarop wordt gefilterd)

Filter listbox (zonder sheet)

Private Sub TextBox1_Change()
Str = TextBox1.Text
If Not Str = "" Then
    With ListBox1
        For i = .ListCount - 1 To 0 Step -1
            If InStr(1, LCase(.List(i, 0)), LCase(Str)) = 0 Then
            .RemoveItem i
            End If
        Next i
    End With
End If
End Sub

 

[whiskey0010]

Bedankt gast0660 dat je hier even naar wilde kijken voor me. Dat werkt perfect.

Nog een kleine vraag. Als ik textbox1 weer zou leegmaken (dus na invoer van iets en dit met backspace wissen) zou ik de gegevens weer terug in de listbox1 zien.

Als je binnenkort een keer tijd hebt voor me

 

[HSV]

Gebruik geen variabelen die door Excel vba al vergeven zijn.

Str

 

[VenA]

Deze code kan niet perfect werken want er wordt alleen gekeken naar de eerste kolom in de listbox en dat is niet de vraag! Waarom je de vragen in #3 negeert zal wel een reden hebben.

 

[HSV]

Was mij ook al opgevallen @VenA; ik zat eigenlijk te wachten op een reactie van de Ts dat het niet perfect zou werken.

 

[whiskey0010]

Hoi Vena en HSV.

Sorry... Op jou vraag #4 De code waar ik mee aan het puzzelen ben en vastloop staat hier boven tussen de code tags en de versie waar ik mee werk is 2010.

De code van gast0660 werkt zoals ik wil maar heb inderdaad een regeltje

dim str

moeten bijvullen.
Op aangeven van HSW hierboven str vervangen door zoekf. Ik mis nu alleen het stukje waarmee de listbox1 weer word gevuld nadat je tekens uit de textbox1 verwijderd.

En zoek ik net op kolom B, C en D vind hij inderdaad niets. Te voorbarig geweest met antwoorden.

 

[gast0660]

Test

Private Sub CommandButton1_Click()
 Dim rng As Range
    Dim i As Long, j As Long, rw As Long
    Dim Myarray() As String
filfin = Range("A65536").End(xlUp).Row
Set rng = Range("b2:H" & filfin)
    With ListBox1
        .Clear
        .ColumnHeads = False
        .ColumnCount = rng.Columns.Count
    ReDim Myarray(rng.Rows.Count, rng.Columns.Count)
    rw = 0
            For i = 1 To rng.Rows.Count
            For j = 0 To rng.Columns.Count
                Myarray(rw, j) = rng.Cells(i, j + 1)
            Next
            rw = rw + 1
        Next
        .List = Myarray
    End With
TextBox1.Value = ""
[COLOR="#FF0000"]With Sheets("Sheet1")
If .AutoFilterMode Then .AutoFilterMode = False
End With[/COLOR]
End Sub

Rode gedeelte als blad ook is geflterd

 

[VenA]

Dit is de vraag.

Ik ben al tijdje aan het rommelen met een scripje voor het zoeken met 1 textbox in alle gegevens die in listbox1 staan.

Verder heb ik gevraagd om een voorbeeldbestand dus als je je zelf de weg kwijt raakt in wat we voor jouw mogen maken dan kan je of zinvol reageren op de gestelde vragen of een programmeur inhuren die het voor jouw maakt.

 

[whiskey0010]

Hoi VenA,

Volgens mij begrijp ik je niet goed. Het "bestand" staat hierboven tussen code tags dus begrijp niet goed waarom ik dat dan ook nog een keer moet uploaden. Ik loop alleen op dat stukje vast vandaar dat ik ook alleen dat stukje hier plaats. De rest van de code heb ik zo goed als werkend.

 

[HSV]

Ik denk dat het uploaden van een bestand is mislukt.

 

[whiskey0010]

Bestandje bijgevoegd in mijn eerste post #1 met de aanpassing van gast0660 post #6.

@gast0660, jou Post 12 krijg ik niet werkend.

 

[VenA]

Lekker veel variatie in het bestandje. Probeer het maar eens waarom het een .xls is ontgaat mij even maar de code zal denk ik wel werken.

 

[HSV]

Private Sub UserForm_Initialize()
 ListBox1.List = Sheets("sheet1").Cells(1).CurrentRegion.SpecialCells(2).Offset(1, 1).SpecialCells(2).Value
End Sub


Private Sub TextBox1_Change()
 With ListBox1
  .List = Sheets("sheet1").Cells(1).CurrentRegion.SpecialCells(2).Offset(1, 1).SpecialCells(2).Value
    For i = .ListCount - 1 To 0 Step -1
     If InStr(LCase(Join(Application.Index(.List(), i + 1, 0))), LCase(TextBox1.Value)) = 0 Then .RemoveItem i
   Next i
 End With
End Sub

 

[snb]

Wat jij wil is onlogisch:

alle gegevens staan in een listbox
zoeken doe je met een combobox
de gegevens van 1 record toon je/wijzig je met textboxes.

Als je alle niet overeenkomende items in een listbox verwijdert, hoe daarna dan verder ?
Wat als geen enkel item overeenkomst ? dan is de listbox leeg.

Vertel eerst maar eens het doel van de exercitie: wat gaat er gebeuren als je 1 item uit de listbox hebt gevonden ?

Structuring precedes coding.

 

[whiskey0010]

Bedankt voor jullie tijd Vena & HSW en gast0660 hier moet ik verder mee kunnen.

.xls weet ik eigenlijk niet. Gewoonte denk ik

SNB, de bedoeling is om in 1 textbox in de gehele inhoud van de listbox te zoeken en weer te geven. Indien geen invoer dan is de listbox inderdaad leeg. Met combobox kan uiteraard ook maar dan heb ik op 6 kolommen 6 comboboxen nodig en dat wil ik niet.