Über Dropdownfeld Farbe mehrerer Spalten ändern

Sub GueltigkeitInSpalteASetzen()

-> entspricht
-> Daten->Gültigkeit...->Reiter Einstellungen
-> Zulassen: Liste
-> Leere Zellen ignorieren: Haken
-> ZellendropDown     : Haken
-> Quelle         : in Arbeit;erledigt;vorgemerkt
 
 Const cSP_AUSWAHL = 1-> entspricht Spalte A
 
 With ActiveSheet.Columns(1).Validation
    .Delete
    .Add Type:=xlValidateList, _
       AlertStyle:=xlValidAlertStop, _
       Operator:=xlBetween, _
       Formula1:=in Arbeit,erledigt,vorgemerkt
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = 
    .ErrorTitle = 
    .InputMessage = 
    .ErrorMessage = 
    .ShowInput = True
    .ShowError = True
 End With
End Sub

Option Explicit
Private Const cSP_AUSWAHL = 1-> entspricht Spalte A

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim Zelle As Range
 For Each Zelle In Target
  If Zelle.Column = cSP_AUSWAHL Then
   Call FarbeDerZeileEntsprechendStringSetzen(Zelle)
  End If
 Next
 Set Zelle = Nothing
End Sub

Private Function FarbeDerZeileEntsprechendStringSetzen(Zelle As Range)

 Dim ws As Worksheet, r As Range
 Dim lLetzteSpalte As Long, lFarbIndex As Long
 Dim txt As String
 
 Set ws = Zelle.Parent
 lLetzteSpalte = ws.UsedRange.Columns.Count + ws.UsedRange.Column - 1
 Set r = ws.Range(ws.Cells(Zelle.Row, 1), ws.Cells(Zelle.Row, lLetzteSpalte))
 txt = Zelle.Value
 Select Case txt
  Case :       lFarbIndex = xlColorIndexNone->keine
  Case in Arbeit:  lFarbIndex = 38       ->hellrosa
  Case erledigt:   lFarbIndex = 35       ->hellgruen
  Case vorgemerkt:  lFarbIndex = 6       ->gelb
  Case Else:
  ->unzulässiger Wert -> löschen
   Application.EnableEvents = False
   Zelle.Value = 
   Application.EnableEvents = True
   lFarbIndex = xlColorIndexNone
 End Select
 r.Interior.ColorIndex = lFarbIndex
 Set ws = Nothing: Set r = Nothing
End Function