Hallo allerseits,

ich bin's mal wieder mit einer Anfrage, die meinen vorherigen Fragen stark ähnelt. Ich schaffe es allerdings irgendwie nicht die Übertragungsarbeit zu leisten.

Ich möchte gerne jeden einzelnen Zelleneintrag eines Bereiches mit allen Text vergleichen, die in bestimmten Formen angezeigt werden. So was Ähnliches musste ich schon mal machen,  nur andersrum (Text einzelner Form in Bereich suchen). Leider kann man den Code wohl nicht einfach so umkehren, wie  ich es mir zunächst erhofft habe. Kann mir bitte jemand helfen? Schon mal vielen Dank dafür.

Beste Grüße

Corina

P.S.: Ziel des Ganzen ist es eines Tages automatisch Shapes zu erstellen anhand von bestimmten Zelleinträgen.

Option Explicit
Sub CreateShapes()

Dim ws As Worksheet
Dim SrchRng
Dim shp As Excel.Shape
Dim c As Range
Dim cellEntry As String
Dim lastRow

On Error GoTo ErrHandler

Set ws = Worksheets("Lists")
lastRow = ws.Cells(Rows.count, 1).End(xlUp).row

With Worksheets("Checklist Structure")
    For Each shp In .Shapes
        If shp.Type = msoAutoShape Then
            If shp.AutoShapeType = msoShapeRoundedRectangle Then
            cellEntry = ws.Range("D3:P" & lastRow).Cells.Value
            SrchRng = shp.TextFrame2.TextRange.Characters.Text
            Set c = SrchRng.Find(cellEntry, LookIn:=xlValues)
                If Not c Is Nothing Then
                MsgBox ("Succes!")
                End If
            End If
        End If
    Next shp
End With


ErrHandler:
Call MsgBox(Err.Description, vbCritical, "Error " & Err.number)


End Sub