Ich habe eine simple Excel Tabelle. Der Tabellenkopf befindet sich in Zeile 1 und beinhaltet in Spalte A "Autobahn" in Spalte B "Länge" und Spalte C "Text" in Zeile 2-5 sind 4 Autobahnen aufgeführt mit den jeweiligen Angabe zu Länge und im Text die Beschreibung der Autobahn in Textform. In der Zelle D2 soll eine Abfrage erfolgen. Wenn in D2 eine der 4 in Spalte A genannten Autobahnbezeichnungen identisch ist, soll Excel die jewilige Textbeschreibung aus Spalte C in einem Textfeld wiedergeben. Ich habe bereits im Menüpunkt Entwicklertools ein Active X Steuerelement - Textfeld eingefügt. Der VBA Code für das Makro, den ich mir bei ChatGPT erfragt habe, funktioniert nicht. Dieser lautet wie folgt:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim selectedAutobahn As String
Dim autobahnRange As Range
Dim description As String
Dim textBox As OLEObject

' Definiere den Bereich für die Autobahnen (Annahme: Daten in den Zellen A2:A5)
Set autobahnRange = Range("A2:A5")

' Überprüfe, ob die Änderung in der Zelle D2 stattgefunden hat
If Target.Address = "$D$2" Then
' Hole den ausgewählten Autobahn-Namen
selectedAutobahn = Target.Value

' Überprüfe, ob der ausgewählte Autobahn-Name in der Liste vorhanden ist
If Application.WorksheetFunction.CountIf(autobahnRange, selectedAutobahn) > 0 Then
' Finde die Zeile, in der der Autobahn-Name gefunden wurde
Dim foundRow As Long
foundRow = autobahnRange.Find(What:=selectedAutobahn, LookIn:=xlValues, LookAt:=xlWhole).Row

' Hole die entsprechende Textbeschreibung aus Spalte C
description = Cells(foundRow, 3).Value

' Aktualisiere das Textfeld mit der Textbeschreibung
Set textBox = ActiveSheet.OLEObjects("TextBox1") ' Ersetze "TextBox1" durch den Namen deines Textfelds
textBox.Object.Text = description
Else
' Setze das Textfeld auf leer, wenn der Autobahn-Name nicht gefunden wurde
Set textBox = ActiveSheet.OLEObjects("TextBox1")
textBox.Object.Text = ""
End If
End If
End Sub

Ich finde den Fehler nicht. Vllt hat jemand eine Idee ? Vielen Dank im Voraus.
https://www.herber.de/bbs/user/166068.xlsm