PDA

View Full Version : VLOOKUP with VBA to loop and paste multiple images in result table



buliing
05-05-2022, 02:54 AM
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

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

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
29724

georgiboy
05-05-2022, 04:53 AM
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

p45cal
05-05-2022, 05:17 AM
Try along the lines of:
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.