Rij verwijderen in werkblad via selectie listbox in Userform

[ericje85]

Al puzzelend kom ik steeds een stuk verder met mijn database. Maar ik ben al twee dagen aan het puzzelen op het volgende probleem en ik kom er niet uit, dus vraag ik nog maar eens hulp hier op het forum bij de echte VBA-experts.
Waar ik tegenaan loop is het volgende: als ik een regel heb geselecteerd via een listbox wil ik deze graag ook met de knop 'verwijderen' uit mijn werkblad kunnen verwijderen. Dezelfde procedure (de geselecteerde regel uit de Listbox verwijderen in de sheet) moet hij ook doen, nadat een cliënt is overgeplaatst van de ene sheet naar de andere via de 'naar behandellijst'. Hij kopieert dan alle gegevens naar de andere sheet en moet dan automatisch ook de regel in de andere sheet verwijderen. Ik neem dus aan dat beide via dezelfde procedure verlopen.

Daarnaast vraag ik me af of dit werkt bij een blad waarbij geen enkele kolom een 'unieke' waarde bevat (in die zin dat in elk kolom het dus kan voorkomen dat een waarde meerdere keren voorkomt en dat hij dus niet op één waarde kan zoeken, maar de gehele rij in zijn geheel moet bekijken en die moet verwijderen.

Ik had al flink zitten zoeken op Internet (en ook hier: http://www.helpmij.nl/forum/showthr...ren-uit-listbox?highlight=listbox+verwijderen), maar ik krijg het niet aan de praat.
Ik heb nu wel een procedure die hij zonder problemen doorloopt (ik krijg geen foutmelding), maar hij doet vrij weinig.

 Private Sub VerwijderenKnop_Click()

MsgBox "Je staat op het punt om de behandeling bij deze cliënt van de wachtlijst te verwijderen. Weet je het zeker?", vbYesNoCancel + vbInformation

Dim i As Long
Dim n As Long
Dim col As New Collection
Dim itm As Variant
Dim rng As Range

n = Me.ListBox.ListCount
For i = n - 1 To 0 Step -1
    If Not Me.ListBox.Selected(i) Then
        If rng Is Nothing Then
           Set rng = Worksheets("Planlijst Behandeling").Range("A:J" & i + 1)
        Else
           Set rng = Union(rng, Worksheets("Planlijst Behandeling").Range("A:J" & i + 1))
        End If
    End If
Next i

If Not rng Is Nothing Then rng.EntireRow.Delete
 blnCancel = False


End Sub

Ook heb ik een voorbeeld in de bijlage gevoegd.

En dan hoop ik dat dit de laatste grootste hobbel is, zodat ik het gehele ding werkend heb.

Bij voorbaat dank!

Groet,
Eric

 

[HSV]

Hier en daar iets gewijzigd.

 

[ericje85]

HSV, dank weer voor je hulp. Hij gaf nog een fout, vanwege een onverwachte 'End if', dus die heb ik weggehaald. En werkt nu als een trein.

Groet Eric

 

[HSV]

Je moet de msgbox nog wel aanpassen.
Bij een cancel verwijderd het de rij alsnog.
Ik heb trouwens de gehele code gewijzigd daar ik dit niet had opgemerkt.
Een listbox begint bij 0 en eindigt bij listbox.listcount -1.

Private Sub VerwijderenKnop_Click()
If MsgBox("Je staat op het punt om de behandeling bij deze cliënt van de wachtlijst te verwijderen. Weet je het zeker?", vbYesNo + vbInformation) = vbYes Then
Dim i As Long
For i = 0 To ListBox.ListCount - 1
    If ListBox.Selected(i) Then
      sn = Sheets("Planlijst behandeling").Cells(1).CurrentRegion
         For jj = 0 To 9
           c00 = c00 & ListBox.List(ListBox.ListIndex, jj) & " "
          Next jj
            For j = 4 To UBound(sn)
              If Join(Application.Index(sn, j, 0)) & " " = c00 Then Sheets("Planlijst behandeling").Rows(j).Delete
       Next j
    End If
Next i
blnCancel = False
End If
End Sub

 

[ericje85]

Thnx HSV, dat had ik inderdaad nog niet opgemerkt. En ik dacht dat de eerste code aanvankelijk vlekkeloos werkte, maar dat bleek van korte duur. Ik weet niet precies wat er mis was, maar de nieuwe code werkt wel. Dus hartstikke bedankt! Ik was er zelf nooit uitgekomen.

 

[ericje85]

OK, nu wil ik dezelfde procedure toepassen, maar dan op een ander werkblad. Ik dacht een en ander te kunnen kopiëren en dan de code aan te passen aan de verwijzing naar de bijbehorende listbox en werkblad. Hij doorloopt de code zonder foutmelding, maar hij verwijdert niet de desbetreffende regel uit mijn werkblad. Zie ik iets over het hoofd? Of betekent dit een grondige wijziging van de code?

Private Sub UitBehandelingKnop_Click()
Dim i As Long
For i = 0 To ListBoxUIT.ListCount - 1
    If ListBoxUIT.Selected(i) Then
      sn = Sheets("In behandeling").Cells(1).CurrentRegion
         For jj = 0 To 9
           c00 = c00 & ListBoxUIT.List(ListBoxUIT.ListIndex, jj) & " "
          Next jj
            For j = 4 To UBound(sn)
              If Join(Application.Index(sn, j, 0)) & " " = c00 Then Sheets("In behandeling").Rows(j).Delete
       Next j
    End If
Next i
blnCancel = False

 

[HSV]

Komen de gegevens van de listbox wel uit tabblad 'In behandeling'?

 

[ericje85]

Hoi HSV,
Ja, dat heb ik dubbel gecheckt. Hij opent een nieuw Userform en daarin pakt hij de juiste gegevens uit het juiste werkblad om de listbox te vullen. Zie onderstaande code, die werkt zonder problemen.

Private Sub UserForm_Initialize()
    With Sheets("In Behandeling")
        sn = .Range("c4:c" & .Cells(Rows.Count, 3).End(xlUp).Row).Value
        With CreateObject("System.Collections.ArrayList")
            For i = 1 To UBound(sn)
                If Not .contains(sn(i, 1)) Then .Add (sn(i, 1))
            Next
            .Sort
            UserNrComboBoxUIT.List = .toarray
        End With
    End With
End Sub
Private Sub UserNrComboBoxUIT_Change()

 With ListBoxUIT
 .List = Cells(1).CurrentRegion.Value
 .ColumnWidths = "0;0;0;0;0;0;0;75;180;100;0;0;0;0"
  For i = .ListCount - 1 To 0 Step -1
    
      If Not .List(i, 2) = Val(UserNrComboBoxUIT) Then
       .RemoveItem i
      End If
  Next i
 End With

For iCount = 0 To Me!ListBoxUIT.ListCount
        Me!ListBoxUIT.Selected(iCount) = False
    Next iCount

End Sub

 

[ericje85]

Tevens volgt er nog een stukje code aan vooraf om te checken dat er geldige data zijn ingevuld en vervolgens gegevens uit de textboxen te kopiëren naar een ander werkblad. Dat werkt ook zonder problemen; hij kopieert netjes de velden. En doorloopt de code verder zonder problemen; alleen het verwijderen van de rij gebeurt niet.

Voor de volledigheid toch maar even de gehele code:

Private Sub UitBehandelingKnop_Click()

    If DatEindBehBoxUIT.Value = "" Then MsgBox "Sorry, er is geen einddatum van de behandeling ingevuld. Voer een datum in.":
    If DatEindBehBoxUIT.Value = "" Then Exit Sub
    DatEindBehBoxUIT.Value = Format(DatEindBehBoxUIT.Value, "dd-mm-yyyy")
    
If IsDate(DatEindBehBoxUIT.Text) Then
    
    Dim LastRow As Long, ws As Worksheet

    Set ws = Sheets("Uit Behandeling")

    LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row + 1 'Finds the last blank row

    ws.Range("A" & LastRow).Value = VoornaamBoxUIT.Text 'Adds the TextBox3 into Col A & Last Blank Row
    ws.Range("A" & LastRow).Offset(0, 1).Value = AchternaamBoxUIT.Text 'Adds the ComboBox1 into Col B & Last Blank Row
    ws.Range("A" & LastRow).Offset(0, 2).Value = UserNrComboBoxUIT.Text
    ws.Range("A" & LastRow).Offset(0, 3).Value = GeslachtBoxUIT.Text
    ws.Range("A" & LastRow).Offset(0, 4).Value = GebDatBoxUIT.Text
    ws.Range("A" & LastRow).Offset(0, 5).Value = LeeftijdBoxUIT.Text
    ws.Range("A" & LastRow).Offset(0, 6).Value = UITCodeBox.Text
    ws.Range("A" & LastRow).Offset(0, 7).Value = AfdelingBoxUIT.Text
    ws.Range("A" & LastRow).Offset(0, 8).Value = BehandelmethodeBoxUIT.Text
    ws.Range("A" & LastRow).Offset(0, 9).Value = IndicatieBoxUIT.Text
    ws.Range("A" & LastRow).Offset(0, 10).Value = DatPLBoxUIT.Text
    ws.Range("A" & LastRow).Offset(0, 11).Value = DatStartBehBoxUIT.Text
    ws.Range("A" & LastRow).Offset(0, 12).Value = DatEindBehBoxUIT.Text
    ws.Range("A" & LastRow).Offset(0, 13).Value = UurPWBoxUIT.Text

    
Dim i As Long
For i = 0 To ListBoxUIT.ListCount - 1
    If ListBoxUIT.Selected(i) Then
      sn = Sheets("In behandeling").Cells(1).CurrentRegion
         For jj = 0 To 9
           c00 = c00 & ListBoxUIT.List(ListBoxUIT.ListIndex, jj) & " "
          Next jj
            For j = 4 To UBound(sn)
              If Join(Application.Index(sn, j, 0)) & " " = c00 Then Sheets("In behandeling").Rows(j).Delete
       Next j
    End If
Next i
blnCancel = False

    For Each cCont In Me.Controls
        If TypeName(cCont) = "ComboBox" Then
        cCont.Value = ""
        End If
        If TypeName(cCont) = "TextBox" Then
        cCont.Value = ""
        End If
        If TypeName(cCont) = "OptionButton" Then
        cCont.Value = False
        End If
    Next cCont
    
End If
End Sub

 

[HSV]

En welk werkblad is actief.
De gegevens die nu in de listbox komen zijn uit het actieve werkblad.

.List = Cells(1).CurrentRegion.Value

 

[ericje85]

Het Userform is alleen te openen via een knop op het desbetreffende werkblad. Dus het juiste werkblad zou direct het actieve werkblad zijn. Zou het er iets mee te maken kunnen hebben dat aanvankelijk het andere werkblad middels 'set' wordt geactiveerd als hij de textboxen gaat kopiëren? En dat ik dan eerst duidelijk moet maken dat hij terug moet gaan naar het actieve werkblad?
Zomaar een idee.

Dim LastRow As Long, ws As Worksheet

Set ws = Sheets("Uit Behandeling")

 

[HSV]

En van dat blad wil je dus ook de rijen verwijderen?
Plaats het bestand anders.

 

[ericje85]

OK, ik zal het bestand even plaatsen; momentje, want dan moet ik een hoop verwijderen omdat het bestand anders te groot is.

 

[HSV]

Sla het bestand eens op als .xlsb (binair) en probeer het eens zo te uploaden

 

[ericje85]

Nee, lukt helaas niet. Ik heb al diverse werkbladen verwijderd, codes gedelete, bestand opgeslagen als binair en gecomprimeerd. Maar het blijft te groot. Als ik nog meer verwijder is de essentie weg en werkt het bestand niet meer. Is er een andere manier mogelijk?

 

[HSV]

Niet comprimeren misschien en gewoon als .xlsb uploaden.
Laatst zat ik al boven de 500kb en normaal is hier maar 100kb mogelijk.

 

[ericje85]

Even een omweg genomen door het bestand te uploaden via WeTransfer:
Uiteraard zijn alle gegevens fictief.

 

[HSV]

Welk tabblad en/of welk knopje moet ik drukken om te testen?

Iets anders:
Elke textbox die een datum vertegenwoordigd moet je wegschrijven met:

ws.Range("A" & LastRow).Offset(0, 12).Value = [COLOR="#FF0000"]CDate([/COLOR]DatEindBehBoxUIT[COLOR="#FF0000"][COLOR="#FF0000"])[/COLOR][/COLOR]

Anders krijg je een Amerikaans datum.

 

[ericje85]

Gaat om het gele tabblad 'In behandeling' en dan bovenste knoppen: 'terug naar wachtlijst' en 'uit behandeling'. Beide moeten dezelfde procedures doorlopen (gegevens opzoeken, textboxen vullen en desgewenst kopiëren naar andere werkbladen) en dan uiteindelijk de geselecteerde rij verwijderen uit het werkblad 'in behandeling'.
Bij beide knoppen kopiëren ze netjes de gegevens en doorlopen de code zonder problemen; maar ze verwijderen de rij daarna niet uit het 'in behandeling'-werkblad.

En thnx voor de tip mbt datumnotatie! Niet bij stilgestaan. Ik pas het aan.

 

[HSV]

Test het zo maar eens weer.