Indien een cel een bepaalde kleur heeft, andere cel leeg maken

[perry99]

Hallo,

Ik ben enorm geholpen door Rudi met onderstaande VBA.
Mijn vraag is als een cel de kleur 4 (groen) krijgt, kan dan de VBA zodanig gemaakt worden dat de cel in kolom E leeg gemaakt wordt.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 And Target <> "" Then
    With Sheets("standaard").Columns(2)
    Set c = .Find("**" & Target.Value, , xlValues, xlWhole)
        If Not c Is Nothing Then
            Target.Offset(, 2).Value = c.Offset(, 1).Value
        Else
            MsgBox "artikelnummer bestaat niet!!!!!": Exit Sub
        End If
    End With
 Target.Offset(, 2).Font.ColorIndex = IIf(WorksheetFunction.CountIf(Columns(4), Target.Value) <= WorksheetFunction. _
        CountIf(Sheets("Standaard").Columns(2), Target.Value), 3, 4)
End If
End Sub

Ik hoop dat jullie mij nog een keer uit de brand kunnen helpen.

Alvast mijn dank voor het meedenken en eventueel oplossen van dit probleem.

Groetjes,

Perry:thumb::thumb::thumb:

 

[perry99]

Hallo,

Ik ben er al uit.

Voor de mensen die het willen weten, zie hieronder.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 4 And Target <> "" Then
    With Sheets("standaard").Columns(2)
    Set c = .Find("**" & Target.Value, , xlValues, xlWhole)
        If Not c Is Nothing Then
            Target.Offset(, 2).Value = c.Offset(, 1).Value
        Else
Target.Offset(, 2).Font.ColorIndex = IIf(WorksheetFunction.CountIf(Columns(4), Target.Value) <= WorksheetFunction. _
        CountIf(Sheets("Standaard").Columns(2), Target.Value), 3, 15)
            Target.Offset(, 1).ClearContents
            MsgBox "artikelnummer bestaat niet!!!!!": Exit Sub
        End If
    End With
 Target.Offset(, 2).Font.ColorIndex = IIf(WorksheetFunction.CountIf(Columns(4), Target.Value) <= WorksheetFunction. _
        CountIf(Sheets("Standaard").Columns(2), Target.Value), 3, 4)
        If Target.Offset(, 1).Font.ColorIndex = 4 Then Target.Offset(, 1).ClearContents
           
End If
End Sub

Groetjes,

Perry