Option Explicit
Public Sub Beispielliste_anlegen()
With ThisWorkbook.Worksheets("Tabelle3")
.Range("B1:D1").Value = Array("Auswahl-01", "Auswahl-02", "Auswahl-03")
Call ThisWorkbook.Names.Add("GListe1", RefersTo:=.Range("B1:D1"))
End With
Call MsgBox("'GListe1' wurde erstellt.", vbInformation)
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error GoTo ErrHandler
Dim rngRef As Excel.Range
Dim rngArea As Excel.Range
Dim rngCells As Excel.Range
Dim rngCell As Excel.Range
Set rngRef = Columns("C")
Set rngCells = Intersect(Target, rngRef)
If Not rngCells Is Nothing Then
For Each rngArea In rngCells.Areas
For Each rngCell In rngArea.Cells
With Cells(rngCell.Row, "D")
If Trim$(rngCell.Value) <> "" Then
Call .Validation.Delete
Call .ClearContents
Call .Validation.Add(xlValidateList, Formula1:="=GListe1")
Else
Call .Validation.Delete
Call .ClearContents
End If
End With
Next
Next
End If
SafeExit:
Application.EnableEvents = True
Exit Sub
ErrHandler:
Call MsgBox(Err.Description, vbCritical, "Fehler " & Err.Number)
GoTo SafeExit
End Sub