Can't show different images on different rows that match cell contents

[Ochimus]

Need to set the attached up so it can show numerous images in Col H at the same time, so need something more than the "1 image placeholder" approach.

User selects or changes a Brand from any DropList in B2 - B4, and the relevant image from Col O should appear in Col H of that row
.
Tried two different approaches but neither work, so hope someone can see what I'm missing

Approach 1:

Private Sub Worksheet_Change(ByVal Target As Range)

       If Not Application.Intersect(Target, Range("E2:E6")) Is Nothing And Not Target.Count > 1 Then
    
        For Each shp In Me.Shapes
           If shp.Type = msoPicture Then
           shp.Visible = msoTrue
           End If
    
       Next
   
       r = Target.Row
     
     Select Case Range("E" & r).Value
     
         Case "Brand A"
         Me.Shapes("Picture 1").Visible = msoTrue
         Range("H" & r) = Me.Shapes("Picture 1")
          
         Case "Brand B"
         Me.Shapes("Picture 2").Visible = msoTrue
         range("H" & r) = Me.Shapes("Picture 2")
         
         Case "Brand C"
         Me.Shapes("Picture 3").Visible = msoTrue
         Range("H" & r) = Me.Shapes("Picture 3")
       
         End Select
            
        End If
        
        With Cells(r, 8)
         .ShapeRange.LockAspectRatio = msoFalse
        .Left = Cells(r, 5).Left
        .Top = Cells(r, 5).Top
        .Width = Cells(r, 5).Width
        .Height = Cells(r, 5).Height
        '.Name = Left(.Cells(r, 1).Value, Len(.Cells(r 1).Value))
        End With
        
    End If
    

exitHandler:
    Application.EnableEvents = True
    Exit Sub

End Sub

APPROACH 2:

Private Sub Worksheet_Change(ByVal Target As Range)

       If Not Application.Intersect(Target, Range("E2:E6")) Is Nothing And Not Target.Count > 1 Then
    
With Cells(r, 8)
         .Pictures.Insert (.Cells(r, 5) & ".jpg")
        .ShapeRange.LockAspectRatio = msoFalse
        .Left = Cells(r, 5).Left
        .Top = Cells(r, 5).Top
        .Width = Cells(r, 5).Width
        .Height = Cells(r, 5).Height
        '.Name = Left(sh2.Cells(r, 1).Value, Len(sh2.Cells(k, 1).Value))
        End With
        
    End If
    
exitHandler:
    Application.EnableEvents = True
    Exit Sub

End Sub

Hope someone can resolve this

Ochimus

[jolivanes]

You could try this.
Change references where required.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, pic As Excel.Picture, pname As String
Set rng = Range("E2:E4")

If Not Application.Intersect(rng, Range(Target.Address)) Is Nothing Then

    For Each pic In ActiveSheet.Pictures
        If pic.TopLeftCell.Address = Columns(14).Find(Target.Value).Offset(, 1).Address Then pname = pic.Name: Exit For
    Next pic

    With ActiveSheet.Shapes(pname).Duplicate
        .Left = Columns(8).Left
        .Top = Cells(Target.Row, 8).Top
    End With

End If
End Sub

[Bo_Ry]

Please try

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Pic As Picture, rn As Range
        If Not Application.Intersect(Target, Range("E2:E6")) Is Nothing And Target.Count = 1 Then
            For Each Pic In ActiveSheet.Pictures
               If Pic.TopLeftCell.Address = Target.Offset(, 3).Address Then Pic.Delete
            Next
            Set rn = Range("N:N").Find(Target.Value).Offset(, 1)
             For Each Pic In ActiveSheet.Pictures
                If Pic.TopLeftCell.Address = rn.Address Then
                    Pic.Copy
                    Target.Offset(, 3).Select
                    ActiveSheet.Pictures.Paste
                End If
            Next
       End If
       Target.Select
End Sub

[Ochimus]

Many thanks to both for the prompt responses and solutions.

Another one you have enabled me to park as Solved!

Ochimus