Hallo allerseits,

sry für meine späte Rückmeldung. Schon mal vielen Dank für den ersten Tipp, das mit dem "On Error GoTo" hatte ich leider überlesen -.-

Nun meine ich auch zu erkennen weshalb das Set rngRef = ActiveSheet.UsedRange.Columns falsch ist. Used Range adressiert immer den gesamten Bereich, aber ich möchte immer gezielt bestimmte Spalten (C, E, J) ansprechen. Wenn was in C steht, soll in D eine DropDown-Liste zur Auswahl stehen. Das gleiche gilt für E in Kombination mit F, sowie für J mit K. Der ursprüngliche Code funktioniert, ist aber nicht sehr elegant. Daher wollte ich mit Select Case arbeiten, um ein paar Zeilen weniger zu haben.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
'Shows dropdown entries for reference columns

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
   
 ' react only to changes within the following range
  Set rngRef = Columns("C")
   
' check for changes
  Set rngCells = Intersect(Target, rngRef)
  If Not rngCells Is Nothing Then
     
    For Each rngArea In rngCells.Areas 'relevant for simultaneous change within several cells
    
      For Each rngCell In rngArea.Cells
         
        With Cells(rngCell.row, "D") 'cell with dropdown list
           
          If Trim$(rngCell.Value) <> "" Then
          '> changed cell contains data => delete dropdown content and set new one
            Call .Validation.Delete
            Call .ClearContents
            Call .Validation.Add(xlValidateList, Formula1:="=Drivers")
          Else
          'changed cell contains data => delete dropdown and content
            Call .Validation.Delete
            Call .ClearContents
          End If
        End With
         
      Next
    Next
     
  End If
  
  Dim rngRef2    As Excel.Range
  Dim rngArea2   As Excel.Range
  Dim rngCells2  As Excel.Range
  Dim rngCell2   As Excel.Range
    
  Set rngRef2 = Columns("E")
    
  Set rngCells2 = Intersect(Target, rngRef2)
       
  If Not rngCells2 Is Nothing Then
             
        For Each rngArea2 In rngCells2.Areas
       
            For Each rngCell2 In rngArea2.Cells
        
                With Cells(rngCell2.row, "F")
           
                    If Trim$(rngCell2.Value) <> "" Then

                        Call .Validation.Delete
                        Call .ClearContents
                        Call .Validation.Add(xlValidateList, Formula1:="=Category")
                    Else

                        Call .Validation.Delete
                        Call .ClearContents
                    End If
                End With
            Next
        Next
  End If
  
  Dim rngRef3    As Excel.Range
  Dim rngArea3   As Excel.Range
  Dim rngCells3  As Excel.Range
  Dim rngCell3   As Excel.Range
    
  Set rngRef3 = Columns("J")
    
  Set rngCells3 = Intersect(Target, rngRef3)
       
  If Not rngCells3 Is Nothing Then
             
       For Each rngArea3 In rngCells3.Areas
       
            For Each rngCell3 In rngArea3.Cells
        
                With Cells(rngCell3.row, "K")
           
                    If IsEmpty(rngCell3.Value) Then
                        Call .Validation.Delete
                        Call .ClearContents
                    Else
                        Call .Validation.Delete
                        Call .ClearContents
                        Call .Validation.Add(xlValidateList, Formula1:="=Organizational_level")
                    End If
                End With
            Next
        Next
  End If

 
SafeExit:
  Application.EnableEvents = True
  Exit Sub
  
ErrHandler:
  Call MsgBox(Err.Description, vbCritical, "Error " & Err.number)
  GoTo SafeExit
   
End Sub

Vielen Dank für eure Unterstützung!

VG