Dynamic images

forexcel

New Member
Joined
Jun 2, 2018
Messages
18
I have an excel file where in sheet1 column A there are club names and in column B their logos (images). In sheet2 at column A are people names and in column B their favourite club. I want to add in column C the logo of their favourite club dynamically. I know how to do this for a single cell (using indirect function at naming) but it is impossible to create names for all people since are over 200.
 

Yongle

Well-known Member
Joined
Mar 11, 2015
Messages
4,714
Office Version
365
Platform
Windows
Here is one simple way using VBA
- you will then need to save the file as macro-enabled

VBA assumes
- team names in both sheets are identical
- sheet containing logos is named "Sheet1"
- each logo in Sheet1 sits totally inside a single cell in column B (logo cell address is derived from logo's TopLeftCell property)
- each logo in Sheet2 sits totally inside a single cell in column C

Running the code
1. The logo in column C is refreshed automaticallty whenever a value is amended in column B in Sheet2
2. Refresh all the logos on Sheet2 with {ALT}{F8} for a list of macros and run RefreshAllLogs


All procedures go in Sheet2's sheet module
- right-click on sheet tab \ View Code \ paste code into that window \ {ALT}{F11} to go back to Excel
Code:
Private Sub Worksheet_Change(ByVal target As Range)
    If target.CountLarge > 1 Or target.Row = 1 Then Exit Sub
    If target.Column = 2 Then Call InsertLogo(target.Offset(, 1))
End Sub
Code:
Private Sub InsertLogo(logoCell As Range)
    Dim pic As Shape, ws As Worksheet
    Set ws = Sheets("Sheet1")
'remove old image
    For Each pic In Me.Shapes
        If pic.TopLeftCell.Address = logoCell.Address Then pic.Delete
    Next
'new image
    For Each pic In ws.Shapes
        If ws.Range(pic.TopLeftCell.Address).Offset(, -1) = logoCell.Offset(, -1) Then
            pic.Copy
            logoCell.Activate
            ActiveSheet.Paste
        End If
    Next
End Sub
Code:
Sub RefreshAllLogos()
    Dim cell As Range
    For Each cell In Me.Range("B2", Me.Range("B" & Rows.Count).End(xlUp))
        Call InsertLogo(cell.Offset(, 1))
    Next cell
End Sub
 

Forum statistics

Threads
1,082,548
Messages
5,366,227
Members
400,880
Latest member
dwb

Some videos you may like

This Week's Hot Topics

Top