• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Listbox vullen, alleen als de cellen leeg zijn in kolom F

Status
Niet open voor verdere reacties.

HWV

Terugkerende gebruiker
Lid geworden
19 feb 2009
Berichten
1.183
Code:
'___________________ZOEKEN OP DEBITEURENNUMMER_____________________________

Private Sub TextBox2_Change()
On Error Resume Next

If TextBox2 = "" Then
TextBox2.BackColor = 16777215
Else
TextBox2.BackColor = 15128749 'licht blauw
End If

ListBox1.BackColor = 15128749
    
    Dim shtSearch As Worksheet
    
    ListBox1.Clear
    Set shtSearch = Sheets("Adressen")
        Locate TextBox2.Text, shtSearch.Range("A2:A50000")
    If ListBox1.ListCount = 0 Then
        ListBox1.AddItem "Geen resultaten gevonden in Adressen"
        ListBox1.List(0, 1) = ""
        ListBox1.List(0, 2) = ""
        ListBox1.List(0, 3) = ""
    End If
End Sub

'___________________ZOEKEN OP leverancier_____________________________

Sub Locate1(Name As String, Data As Range)
On Error Resume Next

    Dim rngFind1 As Range
    Dim strFirstFind1 As String
   
   Me.ListBox1.ColumnWidths = "100;1;150;120"

    With Data
        Set rngFind1 = .Find(Name, LookIn:=xlValues, LookAt:=xlPart)
        If Not rngFind1 Is Nothing Then
            strFirstFind1 = rngFind1.Address
            Do
                If rngFind1.Row > 1 Then
                    ListBox1.AddItem rngFind1.Value
                    ListBox1.List(ListBox1.ListCount - 1, 0) = rngFind1.Columns(0) 'ARTIKELNUMMER
                    ListBox1.List(ListBox1.ListCount - 1, 2) = rngFind1.Columns(1) 'OMSCHRIJVING
                    ListBox1.List(ListBox1.ListCount - 1, 3) = rngFind1.Columns(2) 'VERPAKT PER
                End If
                Set rngFind1 = .FindNext(rngFind1)
            Loop While Not rngFind1 Is Nothing And rngFind1.Address <> strFirstFind1
        End If
    End With
    
End Sub

Deze code gebruik ik in mijn bestand, zie bijlage om een listbox te vullen.
Nu zou ik eigenlijk alleen de lege cellen willen zien in d elistbox vanuit kolom F.
Op deze manier is het bestand sneller, en overbodige regels krijg ik niet meer te zien, aangezien hier al een nummer aan is gegeven.

Ik krijg deze case niet zelf opgelost, vandaar mijn beroep op jullie kennis

Groet Henk
 

Bijlagen

  • Helpmij-Listbox meerdere items selecteren en wegschrijven.xlsm
    44,8 KB · Weergaven: 28
Laatst bewerkt:
Een alternatief gebruikt

Beste,

Ik heb het nu iets anders opgelost, en misschien ook wel de beste oplossing.
Ik filter eerst het bestand op lege cellen, die worden dan overgenomen in de listbox.
Misschien is er wel een optie, maar dit werkt ook.

Groet Henk
 
Twee alternatieven. Maak van jouw gegevensbestand eerst een echte tabel en zet de listcount.op 5

Code:
Private Sub UserForm_Initialize()
  ListBox1.List = Sheets("Adressen").ListObjects(1).DataBodyRange.Value
    For j = ListBox1.ListCount - 1 To 0 Step -1
      If ListBox1.List(j, 5) = "" Then ListBox1.RemoveItem j
    Next j
End Sub

Code:
Private Sub UserForm_Initialize()
  ar = Sheets("Adressen").ListObjects(1).DataBodyRange
  For j = 1 To UBound(ar)
    If ar(j, 6) = "" Then c00 = c00 & j & " "
  Next j
  ListBox1.List = Application.Index(ar, Application.Transpose(Split(c00)), Array(1, 2, 3, 4, 5))
End Sub
 
Ik zou hier een trim plaatsen anders heb je een lege listrow op de laatste positie.

Code:
Application.Transpose(Split([COLOR=#ff0000]trim(c00)[/COLOR]))
 
deels gelukt

Beste,

Dank voor de bijdrage en die die doet wat hij moet doen.
Hij laad de gegevens in als de cellen in kolom F leeg zijn.

Enkel als ik dan wil gaan zoeken in de listbox, dan pakt hij alle gegevens weer, omdat het script voor het zoeken nog steeds is als hierboven in #1 terwijl ik wil zoeken in de gefilterde gegevens.
Hoe kan ik er voor zorgen als ik zoek op nummer textbox2, en op naam textbox 1 dat ik dan zoek in de gefilterde gegevens.

Met het geen dat we nu al hebben, ben ik al erg blij mee, enkel het zou me verder helpen als ik dit ook voor elkaar zou kunnen krijgen met jullie hulp.
Alvst dank voor de reactie.

Henk
 

Bijlagen

  • Helpmij-Listbox meerdere items selecteren en wegschrijven_1.xlsm
    36,3 KB · Weergaven: 24
Probeer het gebruik van On Error Resume next te vermijden. Het onderdrukt alleen fouten. Het instellen van de ColumnWiths kan je net zo goed in het ontwerp van de listbox instellen. In het voorbeeldje een oplossing met een 2e listbox. Werkt alleen voor Textbox1 in het voorbeeldje.
 

Bijlagen

  • Helpmij-Listbox meerdere items selecteren en wegschrijven_1.xlsm
    34,8 KB · Weergaven: 22
Beste VenA,

Dank voor je ondersteuning hierin.
Ik heb het uitgebreid naar meerdere textboxen en het werkt perfect, en doet wat ik voor ogen had.

Groet Henk
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan