Hallo Gabi,

vielen Dank für deine Nachricht... Ich muss mir leider eingestehen, dass mir das Abstraktionsvermögen fehlt, welches wohl erforderlich ist um einen gescheiden Code zu schreiben. Ich versuche immer mein Anliegen in Teilschritte zu zerlegen, aber es kommt nicht viel dabei rum.

Dennoch bin vor Glück beinahe den Tränen nahe, weil ich nun wenigstens einen Code hier posten kann, der wenigstens halbwegs funktioniert :D Er produziert zwar einige falsche Ergebnisse, aber er läuft! Here goes:

Sub Test()
Dim ws As Worksheet
Dim lastRow As Long
Dim SrchRng As Range
Dim c As Range
Dim Found As Boolean
Dim shp As Excel.Shape
Dim myText As Variant
Dim Count As Long
Dim AllCells() As Variant
Dim i As Long

On Error GoTo ErrHandler

Set ws = Worksheets("Lists")
lastRow = ws.Cells(Rows.Count, 1).End(xlUp).row
Set SrchRng = ws.Range("D2:G" & lastRow)

For Each c In SrchRng.Cells
    Found = False
    If c <> "" Then
        For Each shp In Worksheets("Checklist Structure").Shapes
            If shp.Type = msoShapeRoundedRectangle Then
                myText = shp.TextFrame2.TextRange.Characters.Text
                If c.Value = myText Then
                Found = True
                Exit For
                End If
            End If
        Next shp

        If Found = False Then
        Count = Count + 1
        ReDim Preserve AllCells(1 To Count)
        AllCells(Count) = c.Value
        End If
    End If
Next c
For i = LBound(AllCells) To UBound(AllCells)
MsgBox "Shape with text " & AllCells(i) & " is missing."
Next i

Exit Sub
  
ErrHandler:
Call MsgBox(Err.Description, vbCritical, "Fehler " & Err.number)

End Sub

Ich bleibe dran! ;) Allerdings muss ich fairerweise gestehen, dass der letzte Part (ab "If Found") nicht von mir ist... Und dass ich den Teil vorher auf die Reihe bekommen habe, ist das Ergebnis eines mühevollen "Trial and Error" - Prozesses...

Viele Grüße

Corina