VBA - Trying to determine if a Shape exists in a cell in a range

Question

What I am doing: I have exported/copied a sheet of data. that data sheet has checkmark shapes in some of the fields, representing active. I am trying to identify those shapes and if true put a "Yes" in the column next to them and "No" if not.

I borrowed this code for a Function which is in Module - Image Check - that I call on from a cmdbtn "Load" that formats this sheet of data before bring it into my workbook.

Function Check4Image(CellToCheck As Range) As Integer

    
    ' Return 1 if image exists in cell, 0 if not
    Dim wShape As shape
    For Each wShape In ActiveSheet.Shapes
        If wShape.TopLeftCell = CellToCheck Then
            Check4Image = 1
            'Check4Image = 1
        Else
            Check4Image = 0
        End If
    Next wShape
End Function

Script for the Call

Dim proshaperng As Range
Dim proshapecel
Dim proshapeloc As Range
Dim shapeint As Integer

Set proshaperng = Range("F4", "F" & shapeint)   
Set proshapeloc = Range("F4", "F" & shapeint).Cells

For Each proshapecel In proshaperng
     proshapeloc = Range(proshapecel.Address)
        'proshapeloc.Select
        
            Call Check4Image(proshapeloc)
          If Check4Image(proshapeloc) = 1 Then
            proshapeloc.Offset(0, 1) = "Yes"
            Else
            proshapeloc.Offset(0, 1) = "No"
            End If
        Next proshapecel

What I have tried

1. In standard Excel Fx =Check4Image(Cell) and this returns the "1" I expect when the cell has a shape in it

2.I have tried changing the function to a Variant or another variable type Due to a Run Time error 13 Type Mismatch

My thought is that it wants a range and when I try to give it a range it gives me object errors. This may be because the workbook /sheet i'm coping is still open during this process

This worked but it was just for a specific cell reference:

Set proshapeloc = ThisWorkbook.Worksheets("ProcessList").Range("F4")

I'm pretty confused, can someone straighten me out?

Thanks,

Answer 1

You need a different test:

If wShape.TopLeftCell = CellToCheck Then

...this only compares the cell values, not whether they're the same cell.

Something like this would work:

'return any image in the passed cell (or Nothing if none)
Function FindImage(CellToCheck As Range) As Shape
    Dim wShape As Shape, addr
    addr = CellToCheck.Address
    For Each wShape In CellToCheck.Parent.Shapes 'more flexible
        If wShape.TopLeftCell.Address = addr Then
            Set FindImage = wShape
            Exit Function
        End If
    Next wShape
End Function

Sub Tester()
    Dim c As Range
    For Each c In Range("A1:A10").Cells
        c.Offset(0, 1) = IIf(FindImage(c) Is Nothing, "No", "Yes")
    Next c
End Sub