Opgelost Krijg geen goede uitkomst

[Atwist]

Hallo
Ik probeer een Userform te maken die mij de beschikbare nummers laat zien in een Listbox
Maar de uitkomst krijg ik niet goed.
De listbox zou in kolom B moeten kijken naar de eerste vrije cel en dan het betreffende nummer in kolom A laten zien.
Heb zelf al wat in elkaar geprutst met nadruk op geprutst.
Kunnen jullie mij een paar tips geven.

Alvast bedankt voor jullie tijd en moeite.

 

[AHulpje]

Moet de listbox de nummers 4, 10, 16 en 21 laten zien?

 

[Atwist]

Hallo Hulpje

Ja, wand deze nummers zijn beschikbaar.

 

[AD1957]

zo?

Private Sub CommandButton1_Click()
With ListBox1
.List = Blad1.Range("A1:B21").Value
For i = .ListCount - 1 To 0 Step -1
If .List(i, 1) <> "" Then .RemoveItem i
Next
End With
End Sub

p.s. code knopje werkt bij mij niet meer??

 

[edmoor]

Of zo:

 

[AHulpje]

Doe het eens zo:

 

[snb]

Private Sub Userform_initialize()
  ListBox1.List=filter([transpose(if(isblank(B1:B40),row(1:40),"~"))],"~",0)
End Sub

 

[Warme bakkertje]

Private Sub Userform_initialize()
    With Blad1.Cells(1).CurrentRegion
        res = .Parent.Evaluate("Filter(" & .Address & "," & .Columns(2).Address & "="""")")
    End With
    ListBox1.List = Application.Index(res, , 1)
End Sub

 

[Atwist]

Dank jullie voor de moeite.
Al ik jullie bedrage afzonderlijk probeer, werkt het.
Maar nu probeer ik het in mijn werkelijke bestand in te bouwen dan loopt het vast.
Als ik deze (van Edmoor) onder een knop plaats

Private Sub UserForm_Initialize()
    Dim nr() As String
    Dim i As Integer
    Dim y As Integer
    
    y = 0
    With Sheets("Model-nummers")
        For i = 1 To .Range("A1").End(xlDown).Row
            If .Cells(i, 2) = "" Then
                ReDim Preserve nr(y)
                nr(y) = .Cells(i, 1)
                y = y + 1
            End If
        Next i
        ListBox1.List = nr
    End With
End Sub

Dan loopt het vast op

ListBox1.List = nr

Als ik deze (van Hulpje) onder een knop plaats

    a = ActiveSheet.UsedRange()
    For r = 1 To UBound(a)
        If a(r, 2) = "" Then ListBox1.AddItem a(r, 1)
    Next

gaat het mis op de

 For r = 1 To UBound(a)

 

[Atwist]

Bij de code van snb gebeurt er bij mij niets

De code van Rudi heeft ook een probleem met mijn VBA bestand

 

[AHulpje]

Dan heb je het vast niet zo gedaan (n.b. ListBox2 en niet ListBox1):

Private Sub CommandButton3_Click()
    Dim a
    Dim r As Long
    a = ActiveSheet.UsedRange()
    For r = 1 To UBound(a)
        If a(r, 2) = "" Then ListBox2.AddItem a(r, 1)
    Next
End Sub

En ik zou de 312 lege rijen op werkblad Model-nummers verwijderen als ik jou was.
En na Unload Userform1 (beter: Unload Me) gaat dit natuurlijk fout:

TextBox1.Value = " "

 

[Atwist]

Inderdaad weer ergens overheen gekeken wand, nu werkt het wel,

Dankje Hulpje

Ik ga de rest ook aanpassen.

 

[Warme bakkertje]

En dit

Private Sub Userform_initialize()
    Dim res
    With Blad3.Cells(1).CurrentRegion
        res = .Parent.Evaluate("Filter(" & .Address & "," & .Columns(2).Address & "="""")")
        ListBox1.List = .Offset(1).Value
    End With
    ListBox2.List = Application.Index(res, , 1)
    TextBox1.SetFocus
End Sub

werkt even goed.

 

[snb]

gebruik want in plaats van een steile wand.

 

[edmoor]

Dank jullie voor de moeite.
Al ik jullie bedrage afzonderlijk probeer, werkt het.
Maar nu probeer ik het in mijn werkelijke bestand in te bouwen dan loopt het vast.
Als ik deze (van Edmoor) onder een knop plaats

Private Sub UserForm_Initialize()
    Dim nr() As String
    Dim i As Integer
    Dim y As Integer
  
    y = 0
    With Sheets("Model-nummers")
        For i = 1 To .Range("A1").End(xlDown).Row
            If .Cells(i, 2) = "" Then
                ReDim Preserve nr(y)
                nr(y) = .Cells(i, 1)
                y = y + 1
            End If
        Next i
        ListBox1.List = nr
    End With
End Sub

Dan loopt het vast op

ListBox1.List = nr

Werkt hier zonder enig probleem.
"Loopt vast" is ook niet een echte uitleg van wat er dan gebeurt.