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\n\n'  Yields TRUE if the cell identified by row and col contains a picture,\n'  otherwise FALSE\n\n   Dim Caddress      As String\n   Dim Pict          As Object\n   \n   Application.Volatile\n   Caddress = Cell.Address\n   \n   For Each Pict In Application.Caller.Parent.Pictures\n      If Pict.TopLeftCell.Address = Caddress Then\n         HASpic = True\n         Exit Function\n      End If\n   Next Pict\n   HASpic = False\n   \nEnd 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)\n\n'  Yields TRUE if the cell identified by row and col contains a picture,\n'  otherwise FALSE\n\n   Dim Caddress      As String\n   Dim Pict          As Object\n   \n   For Each Cell In x\n      HASpic (Cell)\n   Next Cell\n   \nEnd 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\n\n'  Yields TRUE if the cell identified by row and col contains a picture,\n'  otherwise FALSE\n\n   Dim Pict          As Object\n   \n   Application.Volatile\n   For Each Pict In Application.Caller.Parent.Pictures\n      If Pict.TopLeftCell.Address = Caddress Then\n         HASpic = True\n         Exit Function\n      End If\n   Next Pict\n   HASpic = False\n   \nEnd Function

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

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.

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?

Solution:

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

Formula:

Function:

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

Jagodragon 

Option Explicit\n\n\nPublic Function IsOne(val As Variant) As Boolean\n\nIsOne = False\n\nIf val = 1 Then\n    IsOne = True\nEnd If\n\n\nEnd Function\n\n\nPublic Function IsOneRange(rng As Range) As Variant\n\nDim output() As Boolean\nDim i As Integer\n\nReDim output(1 To rng.Rows.Count)\n\nFor i = 1 To rng.Rows.Count\n    output(i) = IsOne(rng.Cells(i, 1))\nNext i\n\nIsOneRange = Application.WorksheetFunction.Transpose(output)\n\nEnd 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.

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\n\n   Dim output()\n   Dim i As Integer\n      \n   ReDim output(1 To x.Rows.Count)\n   \n   For i = 1 To x.Rows.Count\n      output(i) = HASpic(x.Cells(i, 1).Address)\n   Next i\n   \n   HASpicR = Application.WorksheetFunction.Transpose(output)\n   \nEnd Function

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\n\n'  Yields TRUE if the cell identified by row and col contains a picture,\n'  otherwise FALSE\n    Application.Volatile\n    \n   Dim sourceCell, spillRange, p As Range\n   Dim r, c         As Long\n    Dim s() As Variant\n   \n   r = x.Rows.Count\n   c = x.Columns.Count\n   ReDim s(1 To r, 1 To c)\n   \n   For Each Pict In Application.Caller.Parent.Pictures\n      Set p = Pict.TopLeftCell\n      If Intersect(p, x).Count Then\n         s(p.Row - x.Row + 1, p.Column - x.Column + 1) = True\n      End If\n   Next Pict\n   HASpicR = s\n   \nEnd 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.

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

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\n\n'  Yields TRUE if the cell identified by row and col contains a picture,\n'  otherwise FALSE\n    Application.Volatile\n    \n   Dim p As Range\n   Dim r, c         As Long\n    Dim s() As Variant\n   \n   r = x.Rows.Count\n   c = x.Columns.Count\n   ReDim s(1 To r, 1 To c)\n   \n   For Each Pict In x.Parent.Pictures\n      Set p = Pict.TopLeftCell\n      If Not Intersect(p, x) Is Nothing Then\n         s(p.Row - x.Row + 1, p.Column - x.Column + 1) = True\n      End If\n   Next Pict\n   HASpicR = s\n   \nEnd Function