macro Worksheet_change geeft ongewenst resultaat

[brandernl]

Wederom een Excel rooster toepassing. (bijlage)
1. Middels validatie heb ik een keuze uit mensen (jan, piet en klaas)
2. Ik heb een voorraad van mensen (jan, jan, jan, piet, klaas)
3. Als ik in de gevalideerde cel kies voor 'jan', dan moet er één van mijn voorraad afgaan

Met deze code gebruikt hij mijn hele voorraad aan 'jannen' in een keer op als ik één 'jan' plan. Als de waarde 'jan' gekozen is, moet hij de lus verlaten vanwege de Exit for, maar dat doet ie niet, waarom?

Private Sub Worksheet_Change(ByVal Target As Range)
'    Sub test_antonia()
    Dim Kol As Integer
    Dim rCell As Range
    Dim rRange As Range
    Dim Keuze As String

    Kol = ActiveCell.Column
    Keuze = ActiveCell.Value

    If ActiveCell.Row > 10 Then Exit Sub  'macro moet niet werken buiten invulgebied
'    If Kol < 4 Or Kol > 36 Then Exit Sub        'idem

    Set rRange = Range(Cells(11, Kol), Cells(15, Kol)) 'de range met 'voorraad'

'+++++++++++++++++++++++++++++++++++++++
'+ ga zoeken naar de waarde van de keuzecel in de voorraad
'++++++++++++++++++++++++++++++++++++++++++
        For Each rCell In rRange
'                rCell.Activate
                If rCell = Keuze Then
                    rCell.ClearContents
                Exit For                  'de waarde kan meer dan een keer voorkomen in de voorraad
                End If
        Next
End Sub

Als ik het zo doe, dan doet ie wel de exit for, na het vinden van de eerste 'jan'

Sub test_antonia()
    Dim Kol As Integer
    Dim rCell As Range
    Dim rRange As Range
    Dim Keuze As String

    Kol = ActiveCell.Column
    Keuze = ActiveCell.Value

    If ActiveCell.Row > 10 Then Exit Sub  'macro moet niet werken buiten invulgebied
'    If Kol < 4 Or Kol > 36 Then Exit Sub        'idem

    Set rRange = Range(Cells(11, Kol), Cells(15, Kol)) 'de range met 'voorraad'

'+++++++++++++++++++++++++++++++++++++++
'+ ga zoeken naar de waarde van de keuzecel in de voorraad
'++++++++++++++++++++++++++++++++++++++++++
        For Each rCell In rRange
                If rCell = Keuze Then
                    rCell.ClearContents
                Exit For                  'de waarde kan meer dan een keer voorkomen in de voorraad
                End If
        Next
End Sub

Wat is mijn denkfout?
Bekijk bijlage rooster voor Antonia.xlsm

 

[HSV]

Bernard,

Alle "Jannen" worden verwijderd opdat de code steeds blijft lopen na een change (clearcontents).

Je moet gebruik maken van 'application.enableevents = false' in het begin van de code.
Voor de 'Exit For 'zet je het weer op 'True'
Ook voor de 'End Sub' zet je het weer op 'True'.

 

[brandernl]

Ik begrijp wat excel doet, want het verwijderen van één 'jan' is ook weer een Worksheet_change event

Code aangepast, maar ik raak nog steeds alle 'jannen' kwijt.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Kol As Integer
    Dim rCell As Range
    Dim rRange As Range
    Dim Keuze As String

    Kol = ActiveCell.Column
    Keuze = ActiveCell.Value
    EnableEvents = False
    If ActiveCell.Row > 10 Then Exit Sub  'macro moet niet werken buiten invulgebied
'    If Kol < 4 Or Kol > 36 Then Exit Sub        'idem

    Set rRange = Range(Cells(11, Kol), Cells(15, Kol)) 'de range met 'voorraad'

'+++++++++++++++++++++++++++++++++++++++
'+ ga zoeken naar de waarde van de keuzecel in de voorraad
'++++++++++++++++++++++++++++++++++++++++++
        For Each rCell In rRange
                If rCell = Keuze Then
                    rCell.ClearContents
                EnableEvents = True
                Exit For                  'de waarde kan meer dan een keer voorkomen in de voorraad
                End If
        Next
    EnableEvents = True
End Sub

 

[HSV]

Ben je niet iets vergeten over te nemen van mijn schrijven?

 

[brandernl]

oeps

 

[brandernl]

Harry, ik zou u kunnen kussen :thumb:

Dit is m dus

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Kol As Integer
    Dim rCell As Range
    Dim rRange As Range
    Dim Keuze As String

    Kol = ActiveCell.Column
    Keuze = ActiveCell.Value
    Application.EnableEvents = False
    If ActiveCell.Row > 10 Then Exit Sub  'macro moet niet werken buiten invulgebied
'    If Kol < 4 Or Kol > 36 Then Exit Sub        'idem

    Set rRange = Range(Cells(11, Kol), Cells(15, Kol)) 'de range met 'voorraad'

'+++++++++++++++++++++++++++++++++++++++
'+ ga zoeken naar de waarde van de keuzecel in de voorraad
'++++++++++++++++++++++++++++++++++++++++++
        For Each rCell In rRange
                If rCell = Keuze Then
                    rCell.ClearContents
                Application.EnableEvents = True
                Exit For                  'de waarde kan meer dan een keer voorkomen in de voorraad
                End If
        Next
    Application.EnableEvents = True
End Sub

 

[HSV]

Doe dan maar virtueel Bernard, ik val toch meer voor het ander geslacht. :d

 

[brandernl]

Is overdrachtelijk bedoeld; ik vind (nog steeds) het wonder van Internet en Fora het delen van kennis (om niet).