How to import multiple picture files from folder using cell values for an entire column

Hey all,

Leith Ross put together the code and xls below to pull an image into an excel sheet and place it to the right of A1 if the filename in a designated folder matched the text in A1. (as a response in this thread)

Is there a way to have this functionality work down the entirety of A:A?

I'm imagining that the picRange would be B1 instead (or B#, just the cell next to the relevant A column) and I'd just set a tall row height, so that the pictures are exactly within the cells in B:B next to the filename text.

Is this possible? Any help would be greatly appreciated


Worksheet_Change Event Macro Code

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Cells.Count > 1 Then Exit Sub   
    If Target.Address <> "$A$1" Then Exit Sub
    
        Call ImportPicture(Target.Value)
    
End Sub

Import Picture To Range Macro Code

Sub ImportPicture(ByVal Filename As String)

    Dim Filepath As String
    Dim Pic As Shape
    Dim PicName As String
    Dim PicRange As Range
            
           Set PicRange = ActiveSheet.Range("C2:E14")
           
           PicName = PicRange.Cells(1, 1)
           If PicName <> "" Then ActiveSheet.Shapes(PicName).Delete: PicRange.Cells(1, 1) = ""
           
           Filepath = "C:\Documents and Settings\User\Desktop\Pictures\"
           Filename = Filepath & ActiveCell & ".jpg"
            
            If Dir(Filename) = "" Then Exit Sub
            
            With PicRange
                Set Pic = ActiveSheet.Shapes.AddPicture(Filename, msoFalse, msoTrue, .Left, .Top, .Columns.Width, .Rows.Height)
                PicRange.Cells(1, 1) = Pic.Name
            End With
            
End Sub