SOLVED

Iron Contributor

# Find if range has pictures [Solved with ongoing improvements?]

I have to find if each cell in a range has a picture in it.

I have the script below running in VB and need to figure out how to make it work for a range of cells.

``````Function HASpic(Cell As Range) As Boolean

'  Yields TRUE if the cell identified by row and col contains a picture,
'  otherwise FALSE

Dim Pict          As Object

Application.Volatile

For Each Pict In Application.Caller.Parent.Pictures
HASpic = True
Exit Function
End If
Next Pict
HASpic = False

End Function``````

The code works great but I need it to cycle through all of the cells in a dynamic range. some thing like the pic below. I tried using the code below to call to the first script, but that didn't work. any suggestion?

``````Sub HASpicR(x As Range)

'  Yields TRUE if the cell identified by row and col contains a picture,
'  otherwise FALSE

Dim Pict          As Object

For Each Cell In x
HASpic (Cell)
Next Cell

End Sub``````

Solution:

Edit HASpic function to accept a string for the cell address and run it using a BYROW formula.

Formula:

``=BYROW(B4#,LAMBDA(array,HASpic(ADDRESS(ROW(array),COLUMN(array)))))``

Function:

``````Function HASpic(Caddress As String) As Boolean

'  Yields TRUE if the cell identified by row and col contains a picture,
'  otherwise FALSE

Dim Pict          As Object

Application.Volatile
For Each Pict In Application.Caller.Parent.Pictures
HASpic = True
Exit Function
End If
Next Pict
HASpic = False

End Function``````

This is probably not the most elegant solution. But! It works... So, I'll take it!

26 Replies

# Re: Find if range has pictures

It doesn't work because it doesn't loop through the range or because you haven't assigned the T/F to anything? I would have expected something like:
HASpicR = FALSE
For Each Cell In x
HASpicR = HASpicR OR HASpic (Cell))
Next Cell

EDIT: and noticed that HASpicR would also need to be a FUNCTION of boolean type like the original HASpic function

# Re: Find if range has pictures

Thank you. It is looping now. but it is still only giving me one value. it is not populating a range.

# Re: Find if range has pictures

This didn't get me there. but thank you. I'm Editing the main post to contain the solution right now.

# Re: Find if range has pictures

``````Option Explicit

Public Function IsOne(val As Variant) As Boolean

IsOne = False

If val = 1 Then
IsOne = True
End If

End Function

Public Function IsOneRange(rng As Range) As Variant

Dim output() As Boolean
Dim i As Integer

ReDim output(1 To rng.Rows.Count)

For i = 1 To rng.Rows.Count
output(i) = IsOne(rng.Cells(i, 1))
Next i

IsOneRange = Application.WorksheetFunction.Transpose(output)

End Function``````

To return an array, you must build it in the function. My example above uses a simple "IsOne" instead of "HasPic", but I think you will see the idea.

Let me know if it works.

# Re: Find if range has pictures

@flexyourdata This worked great when combined with the change to make HASpic accept the an address(see edit in main post)! THANK YOU!

``````Function HASpicR(x As Range) As Variant

Dim output()
Dim i As Integer

ReDim output(1 To x.Rows.Count)

For i = 1 To x.Rows.Count
Next i

HASpicR = Application.WorksheetFunction.Transpose(output)

End Function``````

# Re: Find if range has pictures

@Jagodragon  I see you already have your solution but I will submit this because your solution has a few drawbacks.  a) it is only for a single column  b) it is looping through every picture for every cell in the range you are interested in.  so if you have 100 pictures over 300 lines that means 30,000 checks.  I reworked the original function to assign a TRUE value if it is in the range.  I didn't initialize the whole array to FALSE so the output is 0 or True instead of T/F.  But it only loops the pictures 1x and can handle multiple columns.

``````Function HASpicR(x As Range) As Variant

'  Yields TRUE if the cell identified by row and col contains a picture,
'  otherwise FALSE
Application.Volatile

Dim sourceCell, spillRange, p As Range
Dim r, c         As Long
Dim s() As Variant

r = x.Rows.Count
c = x.Columns.Count
ReDim s(1 To r, 1 To c)

For Each Pict In Application.Caller.Parent.Pictures
Set p = Pict.TopLeftCell
If Intersect(p, x).Count Then
s(p.Row - x.Row + 1, p.Column - x.Column + 1) = True
End If
Next Pict
HASpicR = s

End Function``````

I'm guessing you don't need it but since I did it (more for my own satisfaction) i thought I would post it.

# Re: Find if range has pictures

This looks awesome! I will see if I can implement it. I actually had to rework the solution already to allow it to work on a different tab from the source array. So I have to do the same thing here. I'll let you know what I find.

# Re: Find if range has pictures

I get a #value error when I use this code. it has no range output. Am I missing something?

What are the sourceCell, spillRange and p variables used for?

# Re: Find if range has pictures

@Jagodragon See attached.  This is what it should look like: sourceCell and spillRange are left over from something else I was trying and never deleted.

p temporarily holds the top left cell of the picture object as it loops through them.

I didn't do extensive testing so try the attached sheet first and then we can see what is different in your sheet.

# Re: Find if range has pictures

I copy pasted from your workbook to mine and it still gives the same result... I'm at a loss... It works fine in the file you sent... what could be causing this?

# Re: Find if range has pictures

Can you send me a copy of the file?
Are there other objects in the file? I don't know if or why they might be a problem but maybe.

# Re: Find if range has pictures

@mtarler  I replicated the issue in your file to try and debug. your file was much simpler than the one i'm actually working in. Here's what i found.

If there are any pictures outside of the selection area ["=HASpicR(A3:B12)" in your excel file.] then the function fails. I had to add a check if p.Address fell in the range before it got to "If Intersect.."

perhaps there is a better way and I'm just not seeing it? Also, I changed it to output the picture name.

``````Function HASpicR(x As Range) As Variant

'  Yields TRUE if the cell identified by row and col contains a picture,
'  otherwise FALSE
Application.Volatile

Dim sourceCell, spillRange, p As Range
Dim r, c         As Long
Dim s() As Variant

r = x.Rows.Count
c = x.Columns.Count
ReDim s(1 To r, 1 To c)

For Each Cell In x
Next Cell

For Each pict In Application.Caller.Parent.Pictures
Set p = pict.TopLeftCell
For Each Cell In x
If Intersect(p, x).Count Then
'MsgBox ("Works: " & p.Address & "")
s(p.Row - x.Row + 1, p.Column - x.Column + 1) = pict.Name
End If
End If
Next Cell
Next pict
HASpicR = s

End Function``````

# Re: Find if range has pictures

@Jagodragon sry that was a rookie mistake. lol.  here is the corrected code:

``````Function HASpicR(x As Range) As Variant

'  Yields TRUE if the cell identified by row and col contains a picture,
'  otherwise FALSE
Application.Volatile

Dim p As Range
Dim r, c         As Long
Dim s() As Variant

r = x.Rows.Count
c = x.Columns.Count
ReDim s(1 To r, 1 To c)

For Each Pict In Application.Caller.Parent.Pictures
Set p = Pict.TopLeftCell
If Not Intersect(p, x) Is Nothing Then
s(p.Row - x.Row + 1, p.Column - x.Column + 1) = True
End If
Next Pict
HASpicR = s

End Function``````

If Not Intersect(p, x) Is Nothing Then

instead of  If Intersect(p, x).count Then

# Re: Find if range has pictures

Well, this is now the best response. But, I don't know how to change that flag..

# Re: Find if range has pictures

You can go to the ... of the message and select not best response and then select new but that's ok, I appreciate the "Likes" just as well and knowing that it was helpful :)

DONE! thank you

# Re: Find if range has pictures

I actually need this to work across worksheets so I've made a slight change. this works (and I'm happy with it), but I would rather not have to include the SHT string as an optional variable.

also, I just thought i would share incase some one else had the same need.

``````Function HASpicR(x As Range, Optional SHT As String = "") As Variant

'  Yields TRUE if the cell identified by row and col contains a picture,
'  otherwise FALSE
Application.Volatile

Dim p As Range
Dim r, c         As Long
Dim s() As Variant

r = x.Rows.Count
c = x.Columns.Count
ReDim s(1 To r, 1 To c)

If SHT = "" Then
For Each Pict In Application.Caller.Parent.Pictures
Set p = Pict.TopLeftCell
If Not Intersect(p, x) Is Nothing Then
s(p.Row - x.Row + 1, p.Column - x.Column + 1) = True
End If
Next Pict
Else
For Each Pict In Worksheets(SHT).Shapes
Set p = Pict.TopLeftCell
If Not Intersect(p, x) Is Nothing Then
s(p.Row - x.Row + 1, p.Column - x.Column + 1) = True
End If
Next Pict
End If

HASpicR = s

End Function``````

best response confirmed by Jagodragon (Iron Contributor)
Solution

# Re: Find if range has pictures

@Jagodragon good point.  this should address that issue (i.e. search for pictures on the same sheet as the range your select)

``````Function HASpicR(x As Range) As Variant

'  Yields TRUE if the cell identified by row and col contains a picture,
'  otherwise FALSE
Application.Volatile

Dim p As Range
Dim r, c         As Long
Dim s() As Variant

r = x.Rows.Count
c = x.Columns.Count
ReDim s(1 To r, 1 To c)

For Each Pict In x.Parent.Pictures
Set p = Pict.TopLeftCell
If Not Intersect(p, x) Is Nothing Then
s(p.Row - x.Row + 1, p.Column - x.Column + 1) = True
End If
Next Pict
HASpicR = s

End Function``````

# Re: Find if range has pictures

Really? It's that simple? OMG I'm such a newb... Thank you!