VLOOKUP with VBA to loop and paste multiple images in result table

https://i.postimg.cc/1znWTQ7S/Pokemon-table.png


I have a challenge to solve that is getting over my head.


In the Excel card are 3 tables.
Table1 with text entries,
Table2 is a matrix that has the respective photo for the Pokemon name
Table3 should be the result, where only the name and its Pokemon collection should appear as images.


I'm trying to do a VLOOKUP but with multiple images.




I found out how to delete images in the Table3 to make it possible to recalculate based on the pokemon list in Table1

Code:

---

Sub RemoveImages()
    Dim s As Shape, rng As Range
    Set rng = Range("B6:B100")
   
    For Each s In ActiveSheet.Shapes
        If Intersect(rng, s.TopLeftCell) Is Nothing Then
        Else
            s.Delete
        End If
    Next s
End Sub

---

I found out how to loop and copy and paste images

Code:

---

Sub CopyPasteImages()
  For i = 6 To 50
    Range("C" & i).Copy
    Range("D" & i).Select
ActiveSheet.Paste
  Next i
  Application.CutCopyMode = False
End Sub

---

Unfortunately, my VBA skills are not enough to pick the images associated with the Pokemon and display them like in Table3?


could anyone help me please :)

Attached is my Excel file
Attachment 29724

Hi buliing & welcome to the forum,

I have created the attached file, I renamed your images to be the name of the Pokemon as that seemed to make sense, i also changed the column widths in the 'Table3' tab so as each cell can take one image.

There may be more options to follow from others,

Hope this helps

Try along the lines of:

Code:

---

Sub blah()
Set Destn = Sheets("Table3").Range("B6")
For Each cll In Sheets("Table1").Range("B6:B15")
  Destn.Value = cll.Value
  PokemonNames = Split(cll.Offset(, 2).Value, ",")
  ofset = 1
  For Each PokemonName In PokemonNames
    RowNo = Application.Match(Application.Trim(PokemonName), Sheets("Table2").Columns(1), 0)
    If Not IsError(RowNo) Then
      Sheets("Table2").Cells(RowNo, "B").Copy Destn.Offset(, ofset)
      ofset = ofset + 1
    End If
  Next PokemonName
  Set Destn = Destn.Offset(1)
Next cll
End Sub

---

No clearing of destination sheet beforehand, no checks. It places images in adjacent cells (not into the same cell), so ensure columns are wide enough to allow you to see whole image.