Lookup cell in array with image

[jharman7]

I'm trying to create a complete database of professional hockey seasons for all leagues that have existed in North America. The end goal is to be able to state a year/season and which league active in that year I want to display. The first part of completing this is to copy out the standings, top scorers, award winners, etc. for each season of each league. I have the team city, team name, and team logo image in separate cells, followed by wins, losses, points, etc. On a separate sheet, I have a list of every city and team (again in separate cells) as the rows, each year is a separate column, and the contents of the array being the team logo in that year. On the page where I list the season standings, I want the correct team logo image for the given season and team to insert itself next to the team name using a formula.

I've been searching for this a lot online and haven't been able to really solve the issue. I followed a small walkthrough to display an image in a cell based on a reference cell, but this involved creating a named range. This worked great, for a single cell, but it's my understanding that I would have to create a new named range for every single instance I want to copy an image over. At that rate, I might as well just copy and paste the images in manually, which I'm trying to avoid. If anyone could help me out it'd be greatly appreciated. If my problem isn't clear, let me know and I'll try to clarify.

If this isn't even possible using formulas, I've used VBA though I'm extremely novice at it (I'm trying my best, but even loops confuse me haha). So if VBA is the only way, please be patient with my ignorance.

First image below is an example of the first couple years for an early hockey league showing their league name, city name, team name, then their logo for each of the years (very basic example of this). Second image is a breakdown of each of the seasons shown in the first image. I'm wanting the team logo for the given team/season to display in column 'B'.

 

[BSALV]

that's not a big deal, but can you make a small example, just a few teams and their logos.
Then can you deal it with a link (see icon besides the emoticon).

 

[jharman7]

that's not a big deal, but can you make a small example, just a few teams and their logos.
Then can you deal it with a link (see icon besides the emoticon).

I'm not completely sure what you're referring to with the link. I see the icon you're referring to, but I don't know how to link the excel sheet to it like I believe you want me to do. I've created the example sheet as you mentioned, and I apologize for my lack of knowledge with this (just created the account yesterday, though hope to be active on here), but could you explain a bit more what it is I'm supposed to do? Thank you!

 

[mikerickson]

Formulas won't manipulate images the way you want, that would require VBA.

 

[BSALV]

JHarman (you can't upload a file, but you can share a link with a site like OneDrive, google, ...)
the 1st macro fits all the shapes in a cell of sheet overview
the 2nd macro copies the right shape aside the team name

Const COLUMN_LOGOS = 3                                          '<----------------CHANGE HERE THE COLUMN NUMBER IF IT'S NOT IN C OR THE 3RD COLUMN IN SHEET OVERVIEW
Const COLUMN_TEAMS = 1                                          '<----------------CHANGE HERE THE COLUMN NUMBER IF IT'S NOT IN C OR THE 3RD COLUMN IN SHEET "ANOTHER SHEET"



Sub Overview_Shapes()
     '***********************************************************************
     'this macro 'll look in the sheet "overview" in the column "Column_logos" for all shapes,
     'align them with the topleft corner and make them fit in width and height
     ' and name them like the cell on the left
     ' before starting make the column width and the row height for the concerning cells good sized !
     '***********************************************************************

     Set sh = Sheets("Overview")                                'your overview-sheet with the
     For i = 1 To sh.Shapes.Count                               'loop through all shapes in that sheet
          With sh.Shapes(i)                                     ' a certain shape
               Set tlc = .TopLeftCell                           'the topleftcell of that shape
               If tlc.Column = COLUMN_LOGOS Then                'is it in the wanted column, then
                    .Top = tlc.Top + 1                          'align top with top of that cell
                    .Left = tlc.Left + 1                        'align left
                    .LockAspectRatio = msoFalse                 'width and height aren't locked
                    .Width = tlc.Offset(, 1).Left - tlc.Left - 1     'fit the width with the width of that cell
                    .Height = tlc.Offset(1).Top - tlc.Top - 1   'idem for height
                    If Len(tlc.Offset(, -1).Value) > 0 Then .Name = tlc.Offset(, -1).Value     'name it like the cell to the left
               End If
          End With
     Next
End Sub


Sub In_Another_Sheet()
     '****************************************************************
     'this macro 'll look in the sheet "overview" in the column "Column_logos" for all shapes,
     'align them with the topleft corner and make them fit in width and height
     ' and name them like the cell on the left
     '****************************************************************
     Dim shp   As Shape

     Set Sho = Sheets("Overview")
     Set sh = Sheets("Another Sheet")                           'your overview-sheet with the

     sh.Activate                                                'sheet must be the activesheet

     If vbYes = MsgBox("delete all existing shapes in column " & COLUMN_TEAMS + 1, vbYesNo) Then     'ask if actual shapes may be deleted
          For i = sh.Shapes.Count To 1 Step -1                  'loop through all shapes of this sheet
               With sh.Shapes(i)
                    If .TopLeftCell.Column = COLUMN_TEAMS + 1 Then .Delete     'if that shape is in the wanted column then delete
               End With
          Next
     End If

     For Each c In sh.Columns(COLUMN_TEAMS).SpecialCells(xlConstants)     'loop through all cells with text (not formula)

          On Error Resume Next                                  'go on in case of error
          Set shp = Nothing
          Set shp = Sheets("overview").Shapes(c.Value)          'try if there is a shape named like your team in sheet overview
          On Error GoTo 0                                       'no more go on in case of error

          If shp Is Nothing Then                                'no shape with such name
               r = Application.Match(c.Value, Sho.Columns(COLUMN_LOGOS - 1), 0)     'find team name in the column before the shapes in overview
               If IsNumeric(r) Then                             'team name found
                    For i = 1 To sh0.Shapes.Count               'loop through all shapes in that sheet overview
                         If Sho.Shapes(i).Address = Sho.Cells(r, COLUMN_LOGOS) Then     'the address of the logo is jus right of that cell
                              Set shp = Sho.Shapes(i)           'take that shape
                              Exit For                          'stop searching
                         End If
                    Next
               End If
          End If

          If Not shp Is Nothing Then                            'only with a found shape
               shp.Copy                                         'copy shape
               Set tlc = c.Offset(, 1)                          'next to team name in "aonther sheet"
               tlc.Select                                       'select that cell
               ActiveSheet.Paste                                'paste shape
             
               With sh.Shapes(sh.Shapes.Count) 'our shape = shape with the highest index number
                    .Top = tlc.Top + 1                          'align top with top of that cell
                    .Left = tlc.Left + 1                        'align left
                    .LockAspectRatio = msoFalse                 'width and height aren't locked
                    .Width = tlc.Offset(, 1).Left - tlc.Left - 1     'fit the width with the width of that cell
                    .Height = tlc.Offset(1).Top - tlc.Top - 1   'idem for height
               End With
          End If
     Next
   
     Application.CutCopyMode = False
     Application.Goto Range("A1")
End Sub