Consulting

Results 1 to 3 of 3

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

  1. #1
    VBAX Newbie
    Joined
    May 2022
    Posts
    1
    Location

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




    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
    Pokemon.xls
    Attached Images Attached Images

  2. #2
    VBAX Expert
    Joined
    Mar 2008
    Location
    Kent, England
    Posts
    747
    Location
    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
    Attached Files Attached Files
    Last edited by georgiboy; 05-05-2022 at 05:08 AM. Reason: Updated attachment 13:08 05/05/2022
    If things don't change they stay the same
    Quite often there is a picnic problem (problem in chair not in computer)
    "We were not told it was impossible, so we did it."

  3. #3
    Knowledge Base Approver VBAX Wizard
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,565
    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.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •