Loop through cells and check if cell has an image or not

[YasserKhalil]

Hello everyone
How can I loop through cells in range("B2:B100") and detect if the cell ahs an image or not and in the next cell in column c type "No Image" if the cell has no image?

[HansV]

I'd do it the other way round:
First fill C2:C100 with "No Image".
Then loop through the Shapes collection of the worksheet and check if their TopLeftCell is in the range B2:B100. If so, clear the cell next to it in column C.

[YasserKhalil]

Thank you very much. I have followed your instructions and here's a code for review

Code: Select all

Sub Check_If_Images_Exist()
    Dim shp As Shape, m As Long
    With ActiveSheet
        m = Cells(Rows.Count, 1).End(xlUp).Row
        Range("C2:C" & m).Value = "No Image"
        For Each shp In .Shapes
            If shp.Type = 13 Then
                If Not Intersect(.Columns(2), shp.TopLeftCell) Is Nothing Then
                    .Cells(shp.TopLeftCell.Row, 3).ClearContents
                End If
            End If
        Next shp
    End With
End Sub

If the code is OK, how can I filter column C that has some cells with the value "No Image" as when filtering these cells I got images appearing in column B. How can I filter and during the filter hiding those images too?

[HansV]

Set all of the pictures to "Move and size with cells":

S0566.png

If you wish, you can do this with the following macro. You need to run it only once.

Code: Select all

Sub FixImages()
    Dim shp As Shape, m As Long, rng As Range
    m = Cells(Rows.Count, 1).End(xlUp).Row
    Set rng = Range("B2:B" & m)
    For Each shp In ActiveSheet.Shapes
        If shp.Type = 13 Then
            If Not Intersect(rng, shp.TopLeftCell) Is Nothing Then
                shp.Placement = xlMoveAndSize
            End If
        End If
    Next shp
End Sub

After that, the pictures should be hidden when you filter for "No Image", provided that they fit within their cell.

[YasserKhalil]

Thank you very much my tutor for this great assitance.