Repeat VBA Code to run for another cell in the same sheet

Question

Dears, I'm working in a sheet where i need to insert to 2 images from my folder on pc desktop to two different cells "D44" based on value in cell "E5" & other image in "J44" based on the value on cell "G5" I have a code but it only inserts one image to one cell and i need to repeat it to insert the 2nd image in "J44" if there is a value in its related cell G5 can you help me to make the code repeat again and check for the other cell or to edit it to include both of them in one process my images source on pc is: "D:\Desktop\Guards\Guards National IDs"
and here is my code:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim picname As String
Dim pic As Object
Dim source As String

Dim t, l, h, w As Integer

source = Range("D44").Value
picname = "Picture 2"
Set pic = ActiveSheet.Shapes(picname)

With pic
t = .Top
l = .Left
h = .Height
w = .Width

End With

ActiveSheet.Shapes(picname).Delete

Set pic = ActiveSheet.Shapes.AddPicture(source, False, True, l, t, w, h)

pic.Name = picname

End Sub

please need to make the code repeat itself for the other cell or to modify it to do both process

Answer 1

Create a sub in a normal module called replaceImage

Public Sub replaceImage(cSource As Range, PicName As String)

Const pathPictures As String = "D:\Desktop\Guards\Guards National IDs\"

Dim filename As String 'maybe you have to add the file extension
filename = cSource.Value

Dim ws As Worksheet
Set ws = cSource.Parent

Dim oldPicture As Shape
Set oldPicture = ws.Shapes(PicName)

Dim newPicture As Shape

With oldPicture
    Set newPicture = ws.Shapes.AddPicture(pathPictures & filename, False, True, _
                                            .Left, .Top, .Width, .Height)
End With

oldPicture.Delete
newPicture.Name = PicName

End Sub

You can then call this sub from the worksheet_change event like this:

IMPORTANT Adjust the Case statements to your needs!!!

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Dim PicName As String
Select Case Target.Address
    Case "$E$5"
        PicName = "Picture 2"
    
    Case "$G$5"
        PicName = "Picture 3"
End Select

If PicName <> "" Then
    replaceImage Target(1, 1), PicName
End If
    
End Sub

Answer 2

thank you friends for your help I have got this answer from Mr. @Igor and it worked perfectly

Sub Worksheet_Change(ByVal Target As Range)
    Dim ws As Worksheet, pic As Shape, a As Variant, r As Long, path As String
    Set ws = ThisWorkbook.ActiveSheet
    path = "D:\Desktop\Guards\Guards National IDs\"
    'The array below contains picture shape names, condition ranges (numbers in which correlate to picture file names), and add-to ranges
    a = [{"picture1","E5","D44"; "picture2","G5","J44"}] 'Create a 2x3/multidimensional array using the Application.Evaluate [] shortcut.

    For r = LBound(a) To UBound(a)
        If Target.Address(0, 0) = a(r, 2) Then 'consider using If Not Intersect(Target, Range("E5,G5") or Range("E5:G5")) Is Nothing Then...with other changes in the code if you want to change multiple conditions in one swoop
            Debug.Print "Potential edit in sheet: " & ws.Name & " cell: " & Target.Address(0, 0)
            If Target.Value <> "" Then 'delete old pic insert new one
                Debug.Print " (Del old if exists, Add the new: " & a(r, 1) & " into cell: " & a(r, 3) & ")"
                On Error GoTo AddShapeHandler
                Debug.Print " (" & ws.Shapes(a(r, 1)).Name & " exists, deleting)" 'checking if pic exists
                ws.Shapes(a(r, 1)).Delete
AddShapeHandler:
                Debug.Print " (Adding the new " & a(r, 1) & ")"
                ws.Range(a(r, 3)).Select
                path = picPath(path, ws.Range(a(r, 2)).Value)
                If Len(path) < 2 Then Exit Sub 'either the path is invalid or the picture file which name contains ws.Range(a(r, 1)).Value wasn't found
                Set pic = ws.Shapes.AddPicture(path, False, True, ws.Range(a(r, 3)).Left, ws.Range(a(r, 3)).Top, -1, -1) '-1,-1 simply uses the picture's original Width and Height respectively
                pic.Name = a(r, 1)
                Exit For
            Else
                Debug.Print " (Del old if exists: " & a(r, 1) & " and optionally clear cell: " & a(r, 3) & ")"
                On Error GoTo DelShapeHandler
                Debug.Print " (" & ws.Shapes(a(r, 1)).Name & " exists, deleting)" 'checking if pic exists
                ws.Shapes(a(r, 1)).Delete
DelShapeHandler:
'                ws.Range(a(r, 3)).ClearContents 'comment-out if you want keep the existing contents in cells D44, J44
                Exit For
            End If
        End If
    Next
End Sub

Function picPath(path As String, picName As Variant) As String
    Dim fso, file, files, folder As Object
    Set fso = CreateObject("Scripting.FileSystemObject") 'consider using dir() instead of fso
    Debug.Print "  [searching for a picture which name contains: " & picName & " in path: " & path & "]"
    If fso.FolderExists(path) Then 'Path is valid/folder exists
        Set folder = fso.GetFolder(path)
        Set files = folder.files
        If files.Count = 0 Then 'Folder is empty
            Debug.Print "  [(exiting sub): 0 files in " & path & "]"
            picPath = 0: Exit Function 'return 0
        End If
        For Each file In files
            Debug.Print "   [(found the following file: " & file.Name & " in " & path & ")]"
            If InStr(file.Name, picName) Then 'InStr(look_inside, look_for)
                Debug.Print "  [(success): found a picture which name contains: " & picName & " in " & path & "]"
                picPath = file.path: Exit Function 'return picture's path
            End If
        Next
    Else
        Debug.Print "  [(exiting sub): there is a syntax error in the path or the directory/folder doesn't exist, path: " & path & "]"
        picPath = 0: Exit Function 'return 0
    End If
End Function