Koppeling van 2 dropdownlijsten

[theo22]

Beste helpers,
Wie kan mij helpen?

Ik heb het volgende dilemma:
In blad1 cel B12 t/m B14 heb ik daar een dropdownlijst en die heb ik met formule gekoppeld met een andere dropdownlijst in Blad2 in kolom K,M en L. vanaf cel 3 t/m 252.
De koppeling is als volgt:
Blad1 cel B12 gekoppeld met Blad2 kolom K (K3:K252)
Blad1 cel B13 gekoppeld met Blad2 kolom M (M3:M252)
Blad1 cel B14 gekoppeld met Blad2 kolom L (L3:L252)

(In blad1 cel B12 t/m B14 kan ik met dropdownlijst JA OF NEE kiezen en dat geldt ook voor Blad2 Kolom K,M en L vanaf Cel 3 t/m 252)

De bedoeling is dat ik vanaf Blad1 in één keer de dropdownlijst kan selecteren voor Blad2. En in Blad2 de gemaakte keuze nog kan wijzigen.
Het probleem wat ik krijg met formule is het volgende:
Bijvoorbeeld:Als ik in Blad1 cel B12 in de dropdownlijst JA kies en in Blad2 cellen K3:K252 worden ook automatisch JA, maar als ik bijvoorbeeld in Cel K3 of K4 van Blad2 de JA verandereer met NEE via de dropdownlijst dan gaat de formule weg. Daarom wil ik dit via macro doen.

Ik vroeg mij af of iemand weet hoe dat via VBA kan.

Ik zal erg op prijs stellen indien iemand mij kan helpen?

 

[E v R]

Theo, doe er eens een voorbeeldje bij

 

[theo22]

Hierbij een voorbeeldbestand


Alvast bedankt

Theo

 

[E v R]

Theo,

Als ik het goed begrijp wil je de wijziging in Blad1 meteen voor alle keuzes in Blad2 doorvoeren?

Zo ja, plaats dan onderstaande code in het codeblok van Blad1:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Intersect(Target, Range("B12:B14")) Is Nothing Then Exit Sub
    Select Case Target.Address
        Case "$B$12"
            With Sheets("Blad2").Cells(3, 11).Resize(250)
                .Value = Target.Value
            End With
        Case "$B$13"
            With Sheets("Blad2").Cells(3, 12).Resize(250)
                .Value = Target.Value
            End With
        Case "$B$14"
            With Sheets("Blad2").Cells(3, 13).Resize(250)
                .Value = Target.Value
            End With
        Case Else
            Exit Sub
    End Select

End Sub

 

[theo22]

Hoi Eric,

Dat is precies wat ik wilde, heel erg bedankt hij doet het perfect.:thumb:, alleen heb ik een probleem, in blad 2 heb ik al een macro en als ik je code plaats in codeblok van blad 1. en probeer de dropdownlijst te selecteren krijg ik de volgende melding:
Run-time '13':
Type mismatch
en als ik de macro in blad 2 verwijder dan doet hij perfect. en als ik de macro weer plaats in blad 2 krijg ik weer dezelfde melding.
Weet je toevallig hoe ik dit probleem kan oplossen?

Gr. Leo

 

[E v R]

Leo, plaats die code van blad 2 eens

 

[theo22]

Hierbij de code van blad 2

Private Sub Worksheet_Change(ByVal Target As Range)
[COLOR="yellow"]If Target.Column = 7 And Target.Offset(, 2).Value = "Geel" Then[/COLOR]
    With Target.Offset(, 5)
        .Value = "NEE"
   End With
   Exit Sub
Else
    On Error Resume Next
    If IsEmpty(Target.Offset(, 5).Validation.Type) Then
        With Target.Offset(, 5).Validation
            .Delete
            .Add xlValidateList, xlValidAlertStop, xlBetween, "=Lijst"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
        End With
    End If
End If
End Sub

De gemarkeerde code in geel, daar zit waarschijnlijk het probleem, want na de fout markeert macro die code zelf ook in de gele kleur

 

[E v R]

Je kunt het op twee manieren oplossen:
1 de code uit blad 1 aanpassen door er Application.EnableEvents = False aan toe te voegen (1 regel voor select case ...) en 1 regel na End select Application.EnableEvents = True

Je zet dan even de events uit, dus degene die veroorzaakt worden door wijzigingen in blad 2

2 (tevens mijn voorkeur) voeg in de code van blad 2 meteen bovenaan de volgende regel toe:

If Target.Count > 1 Then Exit Sub

Als er meer dan 1 cel verandert dan niks doen

 

[theo22]

Eric, THANK YOU het probleem is opgelost. Heel erg bedankt:thumb:

Gr. Theo:d