een andere waarde automatisch 4 kolommen verder invullen

[ingding]

Hallo allemaal,

Ik ben op zoek naar een vba-code die automatisch start wanneer een cel in kolom A geselecteerd wordt.
Wanneer de celwaarde in kolom A een bepaalde waarde aanneemt, bv "A", dan zou in diezelfde rij, maar 4 kolommen verder, een bepaalde waarde ingevuld moeten worden.

Volgende heb ik in elkaar geknutseld maar werkt niet:

Private Sub Worksheet_Change(ByVal target As range)
If Not Intersect(target, Range("A:A") Is Nothing Then

Select Case ActiveCell
Case "A": ActiveCell(1,5).Select
ActiveCell.Value ="Test"
ActiveCell(1,-3).Select

End Select

End if

End Sub

Bedankt voor de hulp!

 

[SjonR]

zo?

Private Sub Worksheet_Change(ByVal target As Range)
If target.Column = 1 And target.Value = "A" Then Cells(target.Row, 5).Value = "test"
End Sub

 

[ingding]

Werkt perfect! Bedankt!

 

[snb]

Waarom niet steeds target gebruiken ?

Private Sub Worksheet_Change(ByVal target As Range)
  with target
     If .Column & .Value = "1A" Then .offset(,4) = "test"
  end with
End Sub

 

[ingding]

Toch nog een probleem. Een error verschijnt als ik meerdere cellen selecteer en delete.
Gaat om 'Fout 13 tijdens uitvoering - Typen komen niet met elkaar overeen'

Wat doe ik verkeerd?

 

[JEC.]

Private Sub Worksheet_Change(ByVal target As Range)
  with target
     if .count > 1 then exit sub
     If .Column & .Value = "1A" Then .offset(,4) = "test"
  end with
End Sub

 

[ingding]

@JEC.: helaas werkt deze code niet. De code van SjonR wel! Kan je die ook aanpassen?

 

[JEC.]

Kan je eens je bestand plaatsen met daarin bovenstaande code? En dan aangegeven waar het misgaat?

 

[ingding]

Ajb... Nu zou ik bijkomend ook nog een tweede 'Worksheet_Change(ByVal target As Range)' wensen die de 'test' in de kolom verwijderd als de 'OK' in de kolom ernaast ingevuld wordt .

Veel dank voor de hulp alleszins!

 

[ingding]

Deze code werkt precies...

Option Explicit

Private Sub Worksheet_Change(ByVal target As Range)

    If Not Intersect(target, Range("A:A")) Is Nothing Then
        On Error GoTo safe_exit
        
        Application.EnableEvents = False
            
        If target.Column = 1 And target.Value = "A" Then Cells(target.Row, 3).Value = "Test"

        End If
    
    If Not Intersect(target, Range("C:C")) Is Nothing Then
        On Error GoTo safe_exit
        
        Application.EnableEvents = False
            
        If target.Column = 4 And target.Value = "OK" Then Cells(target.Row, 3).Value = ""

        End If
    
    
safe_exit:
    Application.EnableEvents = True

End Sub

 

[JEC.]

Schrijf een M in kolom A
En de OK in kolom E

Private Sub Worksheet_Change(ByVal target As Range)
  With target
     If .Count > 1 Then Exit Sub
     Select Case .Column
       Case 1: If .Value = "M" Then .Offset(, 3) = "test"
       Case 5: If .Value = "OK" Then .Offset(, -1) = ""
     End Select
  End With
End Sub