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.
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.
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
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,176
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top