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.

 

[yky]

I can't really tell what you want. Would you elaborate or explain it in a different way?

 

[Jasen79]

Yes, Thank you for your reply.
In the code you helped with I was looking only at: For Each a In Array("A38", "F38", "A54", "F54").
That worked great for that template. But now I need each column instead of a single cells.
I still need the pictures inserted in the three cells but I need many many more rows.
The source data will grow and sink. It will not always be the same amount of rows but will always be the same columns.
In my example I have 4 rows. But tomorrow I might have 30+ , and the next day only 2.
So I am hoping the code could state any date in column 9, 10, 11 then insert correct picture.
Understand, man I hope so.

 

[yky]

So, row 1 in column 9, 10, 11 are headers and are followed by picture names? Are there always same number of pictures in each column? It'd be easier if column 9, 10, 11 all have the same number of pictures to be inserted.

 

[Jasen79]

So, row 1 in column 9, 10, 11 are headers and are followed by picture names? Are there always same number of pictures in each column? It'd be easier if column 9, 10, 11 all have the same number of pictures to be inserted.

Sorry, Yes. You are correct Row 1 will be the Header.
The number of rows will change.
Column 9-11 should always have the need to have pictures to be inserted.
Column 9-11 will either have no data or a file name.jpg in it.
Does that help?

 

[yky]

Sorry, Yes. You are correct Row 1 will be the Header.
The number of rows will change.
Column 9-11 should always have the need to have pictures to be inserted.
Column 9-11 will either have no data or a file name.jpg in it.
Does that help?

There are two scenarios I can think of. A. number of rows will change but each column (9, 10, 11) will have same number of row, and B. different column will have different number of rows. That will make a slight difference in programming.

 

[Jasen79]

There are two scenarios I can think of. A. number of rows will change but each column (9, 10, 11) will have same number of row, and B. different column will have different number of rows. That will make a slight difference in programming.

I am a little confused and how you wrote scenario A.

I think scenario B fits best. In the very top example, the workbook shows row 1 as the headers of the column, then 4 more rows. The columns with the headers Photo 1, Photo 2, & Photo 3 will always have .jpg names in them. The number of rows will grow over time and then shrink later. But the overall format (Number of Columns) will stay the same. Only the number of rows will change.

Does that better help explain? And thank you for your time and help. I know there is some sort of solution to this puzzle.

 

[yky]

Let me ask it in a different way. Are the last row for columns 9, 10, 11 always n, n, n or could they be n, n+m, n+o?

 

[Jasen79]

Let me ask it in a different way. Are the last row for columns 9, 10, 11 always n, n, n or could they be n, n+m, n+o?

If I understand you, it will always be n, n, n.

 

[yky]

Try this:

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
    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
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 a As Variant, cel As Range, picPath As String
    Dim 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

Please note that I have commented out some lines in the original code. I'm not sure which sheet it is. So, there might be a problem.