VBA Add Pictures assigned to column range

[Jasen79]

Sub InsertirPictures()
' Help from YKY & RoryA
' Personal Note: Below file path needs to be changed to where the IR phots are located!!!
'
    Const fPath = "C:\Users\576186\Pictures\"
    Dim a As Variant, cel As Range, picPath As String
      For Each a In Array("A38", "F38", "A54", "F54")
        Set cel = Range(a)
        picPath = fPath & cel.Value
               If Not Dir(picPath, vbDirectory) = vbNullString Then
            cel.Worksheet.Shapes.AddPicture Filename:=picPath, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
            Top:=cel.Offset(, 0).Top, Left:=cel.Offset(, 0).Left, Width:=209, Height:=209

        End If
    Next a
End Sub

ISSUE #	FLOOR	ROOM	WALL / Floor / Ceiling / or GRID LINES	OVERHEAD / OCCUPIED SPACE / UNDERFLOOR	DESCRIPTION /LOCATION	TYPE TAG	ISSUE #	PHOTO	PHOTO 2	PHOTO 3
1	Basement	020-Hall	WEST WALL	OCCUPIED SPACE	remember to link some pics	ABANDONED Conductor	1	TK1.jpg	TK2.jpg	TK3.jpg
2	Basement	020-Hall	SOUTH WALL	OCCUPIED SPACE	0	ABANDONED Conductor	2	TK4.jpg	EUCOM.JPG	PAE.JPG
3	Basement	19	SOUTH WALL	OCCUPIED SPACE	0	ABANDONED Conductor	3	0	0	0
4	Basement	19	SOUTH WALL	OCCUPIED SPACE	0	Building Material Left in Wall	4	0	0	0

Good Day, I am hoping one of you Brilliant coders can once again help or guide me to a solution.
In this workbook we consolidate all our reports on to one worksheet that we have gathered from multiple users. On the next worksheet, I filter the data needed at the time and export the findings in one format or another. PDF, Print, or Email.
There are pictures that are associated with date and are saved in folder. I need those pictures to be saved in the excel workbook. I am using a formula from another workbook some fine coders here helped me with. Now I need this code to look up an array of cells and over three columns. The data set may grow or shrink so I did not want a set cell but a flexible range.
Attached is the code I have.
And what the workbook looks like.
Can you please help?
Thanks in advance.

 

[Jasen79]

First thank you for taking the time.
Ran into a few issues.
When I ran the code the photos in column “I” were inserted. But nothing in columns J & K where not inserted. Please see errors below.
First Error Excel “An error occurred while importing this file. C:\Users\576186\Pictures\”
Second Error MVB: “Run-time error ‘1004’:
Application-defined or object-defined error

 

[Jasen79]

Sub main()

    Dim last_row As Long
    Dim cell As Range
    Dim col_num As Long
    Dim j As Long, i As Long

    last_row = Sheets(1).Range("I65536").End(xlUp).Row
    For j = 2 To last_row Step 1
    For i = 9 To 11 Step 1
        
                
            InsertirPictures Cells(j, i)

        Next i
    Next j

End Sub
Sub InsertirPictures(cel As Range)
    ' Help from YKY & RoryA
    ' Personal Note: Below file path needs to be changed to where the IR phots are located!!!
    '
    Const fPath = "C:\Users\576186\Pictures\"

    Dim picPath As String

    picPath = fPath & cel.Value
    If Not Dir(picPath, vbDirectory) = vbNullString Then
        cel.Worksheet.Shapes.AddPicture Filename:=picPath, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
        Top:=cel.Offset(, 0).Top, Left:=cel.Offset(, 0).Left, Width:=125, Height:=125

    End If

End Sub

OK, so after a little bit of trial and error, I found a Partial solution.
Reversing the Dim Cell and col_num at the top and flipping them in the code, all the pictures will now insert. However, I still get the same errors.
Also Solved the sizing issue.
Still getting:
First Error Excel “An error occurred while importing this file. C:\Users\576186\Pictures\”
Second Error MVB: “Run-time error ‘1004’:
Application-defined or object-defined error

 

[yky]

First thank you for taking the time.
Ran into a few issues.
When I ran the code the photos in column “I” were inserted. But nothing in columns J & K where not inserted. Please see errors below.
First Error Excel “An error occurred while importing this file. C:\Users\576186\Pictures\”
Second Error MVB: “Run-time error ‘1004’:
Application-defined or object-defined error

Looking at your data, I now see the problem. How do you get the zero in the cells? Do those cells contain a formula? I think the code is looking for 0.jpg which doesn't exist.

Change the main sub to the following. The new code will skip the cells that contain 0. Regarding the other error, do you know on which line the error occurs?

Sub main()

    Dim last_row As Long
    Dim col_num As Long
    Dim cell As Range
    Dim i As Long, j As Long

    last_row = Sheets(1).Range("I65536").End(xlUp).Row
    
    Do While Sheets(1).Cells(last_row, 9) = 0
        last_row = last_row - 1
    Loop
    
    For i = 9 To 11 Step 1
        For j = 2 To last_row Step 1

            InsertirPictures Cells(j, i)

        Next j
    Next i
End Sub

 

[Jasen79]

Looking at your data, I now see the problem. How do you get the zero in the cells? Do those cells contain a formula? I think the code is looking for 0.jpg which doesn't exist.

Change the main sub to the following. The new code will skip the cells that contain 0. Regarding the other error, do you know on which line the error occurs?

Sub main()

    Dim last_row As Long
    Dim col_num As Long
    Dim cell As Range
    Dim i As Long, j As Long

    last_row = Sheets(1).Range("I65536").End(xlUp).Row
   
    Do While Sheets(1).Cells(last_row, 9) = 0
        last_row = last_row - 1
    Loop
   
    For i = 9 To 11 Step 1
        For j = 2 To last_row Step 1

            InsertirPictures Cells(j, i)

        Next j
    Next i
End Sub

Same error codes with the new code and only column I pictures where inserted. I took the when line of code you added to the last version. All pictures where inserted. Both ways I get the same error code even though it is doing what I need it to do.

When I run the debug this Is highlighted:
cel.Worksheet.Shapes.AddPicture Filename:=picPath, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
Top:=cel.Offset(, 0).Top, Left:=cel.Offset(, 0).Left, Width:=125, Height:=125

 

[yky]

Same error codes with the new code and only column I pictures where inserted. I took the when line of code you added to the last version. All pictures where inserted. Both ways I get the same error code even though it is doing what I need it to do.

When I run the debug this Is highlighted:
cel.Worksheet.Shapes.AddPicture Filename:=picPath, LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, _
Top:=cel.Offset(, 0).Top, Left:=cel.Offset(, 0).Left, Width:=125, Height:=125

I just tested the code on my PC and didn't get any error message. I had I2:k4 with picture names and all those cells were filled with pictures. Not sure why you'd get errors. Sorry! Can't help on that one.

 

[Jasen79]

I just tested the code on my PC and didn't get any error message. I had I2:k4 with picture names and all those cells were filled with pictures. Not sure why you'd get errors. Sorry! Can't help on that one.

Thank you so much for your help.
Here is something odd. I ran it on Excel 2010 and would fine no issues or errors.
Only get the errors on mine, Excel 365.
And it wouldn't even run on the Mac version.
Thank you again.
Send me a direct message and I will send you some chocolate from Germany where I am at right now.
All the best and happy holiday.

 

[yky]

Thank you so much for your help.
Here is something odd. I ran it on Excel 2010 and would fine no issues or errors.
Only get the errors on mine, Excel 365.
And it wouldn't even run on the Mac version.
Thank you again.
Send me a direct message and I will send you some chocolate from Germany where I am at right now.
All the best and happy holiday.

I have heard comments that Mac version of Excel doesn't work well. The suggestion is to run Windows emulation on Mac and then run Windows' version of Excel on Mac. I can't test that idea because I don't use Mac. Since the code still works albeit the error message, maybe you just need to put up with the error message.

Thanks for the offer and happy holiday.