Rij toevoegen of verwijderen bij wijziging target.value

Status
Niet open voor verdere reacties.
B

Boboes

Gebruiker
Lid geworden
5 nov 2016
Berichten
45
Zie bijgevoegd bestandje met volledig fictieve gegevens. Code staat in worksheet 'Van'.

Bestand heeft 2 werkbladen: 'Van' en 'Naar'. Wanneer in blad 'Van' in kolom G gekozen wordt voor 'Ja' dan worden een aantal gegevens uit die rij gekopieerd naar blad 'Naar'. Twee vragen/problemen:

1. Op zich werkt het kopiëren/toevoegen wel met de Worksheet_Change Target-code in blad 'Van', maar hoe voorkom je dat dezelfde regel nogmaals wordt toegevoegd als er nog een keer 'Ja' wordt ingevuld? Voordat er gekopieerd zou worden zou programma moeten kijken of het ID (kolom C) uit desbetreffende rij niet al voorkomt in blad 'Naar'. Als dat zo is dan hoeft er namelijk niets gekopieerd te worden.

2. Andersom: hoe verwijder je een volledige regel in blad 'Naar' wanneer in blad 'Van' de Target.Value gewijzigd wordt naar 'Nee' of blanco? Ook hier is de waarde in kolom C weer de key voor de beoordeling of desbetreffende regel moet worden verwijderd.

Iedereen alvast bedankt voor het meedenken!

Christ
 

Bijlagen

  • Test Van-Naar.xlsm
    17,6 KB · Weergaven: 28
Probeer het zo eens.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim f As Range
  If Target.Column = 7 And Target.Count = 1 Then
    With Sheets("Naar")
      Select Case Target
        Case "Ja"
          If Application.CountIf(.Columns(3), Target.Offset(, -4)) = 0 Then .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 4) = Target.Offset(, -6).Resize(, 4).Value
        Case "Nee"
          Set f = .Columns(3).Find(Target.Offset(, -4).Value, , xlValues, xlWhole)
          If Not f Is Nothing Then f.EntireRow.Delete
      End Select
    End With
  End If
End Sub
 
Top! Het werkt en de code is veel korter.
VenA, hartelijk dank voor jouw oplossing!
:d

Christ
 
Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
    If Target = "Ja" Then
    With Cells(1).CurrentRegion
       .AutoFilter 7, "Ja"
       .Offset(1).Resize(, 4).Copy Blad2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
       .AutoFilter
     End With
     Target = ""
    End If
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan