Hallo Phaona,

hab mal versucht den Code auseinanderzunehmen. Bin nicht sicher ob ich das so richtig verstehe. Die Qualität des Codes bewerte ich mal nicht. Bist ja noch nicht weit fortgeschritten. Solange er funktioniert, kann er aber so schlecht nicht sein.

1. Kapier ich aber überhaupt nicht. Wenn du wegklickst in eine andere Zelle und dann wieder in die Zelle, welche die Liste enthält, öffnet sich doch wie gewollt die Liste (hast du so programmiert). Und mit öffnen der Liste wird der in der Zelle enthaltene Wert markiert. Zumindest bei mir. Oder meinst du wenn du die bereits markierte Zelle nochmal anklickst? Dann schließt sich die Liste, das ist Standard und lässt sich nicht ändern. Aber du kannst vermeiden, dass du versehentlich in die Zelle rein klickst und stattdessen durch Doppelklick die Liste wieder öffnen. Hab das Before_Doubleklick-Ereignis mal deinem Code hinzugefügt.

2. Warum er bei SendKeys "%{down}" nicht nur die Liste öffnet sondern auch NumLock deaktiviert bzw. wieder aktiviert kann ich dir auch nicht sagen. Das ist ein wirklich nerviger Fehler im System. Aber das Problem kann man umgehen: Verwende stattdessen WshShell.Sendkeys und der Spuk ist vorbei. Hab ich dir mal im unten stehenden Code gleich mit eingebaut. Durch SendKeys "{SCROLLLOCK}" wird natürlich die Rollen-Taste aktiviert bzw. deaktiviert. Wenn du das nicht willst, lass diesen Befehl doch einfach weg. Hab ihn mal auskommentiert.

Den Code zur Sub floating_buttons hast du nicht gepostet. Ich kann also nicht beurteilen, ob dieser noch irgendwelche Auswirkungen hat.

'Dropdown mit Mehrfachauswahl & Remove if Double
Private Sub Worksheet_Change(ByVal Target As Range)
  Dim rngDV As Range
  Dim oldVal As String
  Dim newVal As String
  Dim lUsed As Long
  
  If Target.Count > 1 Then GoTo exitHandler
  If IsNumeric(Target) Then GoTo exitHandler
  If IsDate(Target) Then GoTo exitHandler
  If Target.HasFormula Then GoTo exitHandler
  On Error GoTo exitHandler
  If Target.Validation.Type <> 3 Then GoTo exitHandler
  
  'x = (Target.Validation)
  On Error Resume Next
  Set rngDV = Cells.SpecialCells(xlCellTypeConstants)
  
  On Error GoTo exitHandler
  If rngDV Is Nothing Then GoTo exitHandler
  If Not Intersect(Target, Me.Range("Verein")) Is Nothing Then Exit Sub
  Application.EnableEvents = False
  newVal = Target.Value
  Application.Undo
  oldVal = Target.Value
  Target.Value = newVal
  If Target.Column >= 2 Then '>=3 weil ab Spalte C
    If InStr(1, Target.Validation.Formula1, "=Liste") > 0 Then
      If oldVal = "" Then
        'do nothing
      Else
        If newVal = "" Then
          'do nothing
        Else
          lUsed = InStr(1, oldVal, newVal)
          If lUsed > 0 Then
            If Right(oldVal, Len(newVal)) = newVal Then
              Target.Value = Left(oldVal, Len(oldVal) - Len(newVal) - 2)
            Else
              Target.Value = Replace(oldVal, newVal & ", ", "")
            End If
          Else
            Target.Value = oldVal & ", " & newVal
          End If
        End If
      End If
    End If
  End If
  
exitHandler:
  Application.EnableEvents = True
End Sub
'open dropdown
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  
  Dim WshShell As Object
  Set WshShell = CreateObject("WScript.Shell")
  
  If (Target.Column > 8) Then
    Call floating_buttons
  Else
    On Error GoTo Err1:
    
    'If Target.Cells.Count = 1 Then
    If Target.Validation.InCellDropdown = True Then
      WshShell.SendKeys ("%{DOWN}")
    End If
  End If
   
  'MsgBox "Vorher"
  WshShell.SendKeys "%{DOWN}" ', True
  'MsgBox "Nachher"
  'DoEvents
  'SendKeys "{SCROLLLOCK}"

Err1:
  'do nothing
End Sub
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  Worksheet_SelectionChange Target
  Cancel = True
End Sub

Gruß Mr. K.