Compare each cell entry with shape text

[VBAnoob_Corina]

Hello everybody,

hope you can help me with the following problem: I'm trying to compare some cell entries from a worksheet to some shape text on another sheet. I have written some code already, but I get nothing but errors no matter what I try. The cell entries are located in "Lists", in the columns D-G and each amount of entries may vary. My shapes are plain rounded rectangles located in "Checklist Structure". I need this comparison as a condition for some further code which generates and places new shapes for entries not matching any shape text. I hope you can somehow understand what I'm trying to achieve I'm also very grateful for any help I can get. Thank you very much for the support!

Kind regards,
VBAnoob_Corina (The name says it all )

Option Explicit
Sub CreateShapes()

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

On Error GoTo ErrHandler

Set ws = Worksheets("Lists")
Set shp = Worksheets("Checklist Structure").Shapes(1)
lastRow = ws.Cells(Rows.count, 1).End(xlUp).row
Set SrchRng = ws.Range("D3:P" & lastRow)
myText = shp.TextFrame2.TextRange.Characters.Text
cellEntry = SrchRng.Cells.Value

With ws
    For Each cellEntry In SrchRng
        If cellEntry <> "" Then 'If cell is not blank then compare entry with each shape text
        Set c = SrchRng.Find(cellEntry, LookIn:=myText)
             If Not c Is Nothing Then 'do nothing
             Else
             MsgBox ("Bisher klappts!")
             End If
        Else 'do nothing
        End If
    Next cellEntry
End With

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


End Sub

 

[Sektor]

Hi, Corina.
Which error you have and which line is highlighted?

 

[Andrew Poulsom]

I'm not going to write the code for you, but I would loop around the shapes, extract the text and try to find it in SrchRng.

 

[VBAnoob_Corina]

Hi, Corina.
Which error you have and which line is highlighted?

The highlighted line is

Set c = SrchRng.Find(cellEntry, LookIn:=myText)

I get a run-time error 13, type mismatch...

 

[Sektor]

You need to use one of the values in enumeration XlFindLookIn for LookIn argument: xlComments, xlFormulas and xlValues.
But you have "myText" - that's why you get error.

 

[VBAnoob_Corina]

I'm not going to write the code for you, but I would loop around the shapes, extract the text and try to find it in SrchRng.

Hello Andrew,

thank you for your answer. Maybe my next question is a bit stupid, but I have absolutely no VBA or other programming experience. Anyway, doesn't it make a difference whether I search each shape text in my other sheet's entries? At first glance, I do not get the point of doing this because the shape text will be there (the "crowd" of shape text is included in the other cell entries). What I want to find out is whether a cell entry doesn't have a matching shape text and then create one...

Hope you can understand what I mean

 

[VBAnoob_Corina]

Oh ok, thank you. I changed that part to xlValues. But another problem which occurs is that my code doesn't seem to recognize that the cells in the defined range actually do have text entries. After the first If, it jumps straight to the Else part and does nothing...

If cellEntry <> "" Then 'If cell is not blank then compare entry with each shape text
         Set c = SrchRng.Find(cellEntry, LookIn:=xlValues)
             If Not c Is Nothing Then 'do nothing
             Else
             MsgBox ("Bisher klappts!")
             End If
Else 'do nothing
End If</pre>

 

[Sektor]

It means that the cell is NOT empty. There can be situation when a cell contains formula but returns empty string. Anyway, the cell is considered as NOT empty.

 

[Andrew Poulsom]

Does each shape contain the same text as one of the cells in SrchRng?

 

[VBAnoob_Corina]

Does each shape contain the same text as one of the cells in SrchRng?

Yes. But not each text from the cells is used as a shape text...