Images copying to another cell

[zendog1960]

I have an image in A1. Basically a Rugby team logo. I have another one in B1.

In A2 I have the team name and in B2 I have the other team name.

If team A2 wins their match, I want to copy the picture to D1. I will be manually inputting the team name into D2. Just wanted to find out if there was a way that depending on the team name in D2 it would copy the corresponding picture into D1.

I hope this is kind of streamlined code because I have about 32 teams I am tracking for a tournament.

Any and all help would be greatly appreciated.

[Bob Phillips]

You don't have images in a cell, it may look like it, but images are not embedded in cells, they are a separate layer.

What you need to do is assign names to the images that is related to the team, such as imgWasps, and then derive that from the winning team name.

[zendog1960]

I realize this. I am just not sure how to code that. I tried doing it in the excel environment but it does not recognize the name I gave the picture. So I am thinking it must be done via VBA.

If anyone can give me the heads up even on the example I have given, I would be extremely appreciative!

[JimmyTheHand]

Hi Zendog

You might want to take a look at this post (and thread)

http://vbaexpress.com/forum/showpost...67&postcount=2

The attached workbook simulates a Blackjack game. The code includes a part that copies pictures into certain cells:

[vba] Serial = Round(Rnd(1) * 9) + 866
ActiveSheet.Shapes("Picture " & CStr(Serial)).Copy
Cells(1, Counter + 3).Select
ActiveSheet.Paste
[/vba] You refer to a picture by its name. In this particular example, pictures' names were "Picture 866", "Picture 867" etc., and the serial number was generated randomly when dealing a new card.

This might be a good start. If not, then could you upload your workbook?


Jimmy

[zendog1960]

I tried playing around with it a bit but still having problems with getting the pics to work out right. I have attached the sample workbook for your reference as previously asked for. Everything I am trying to accomplish is stated in the workbook.

I hope someone can help me out here. I am fairly new to VBA but learning fast. I am stumped and now my stubborn side is tell me to find out how this is done.

Thanks in advance for all your help!

[mdmackillop]

Here's one method to try. Needs a bit more work!


[vba]Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TeamPic As Range, Pic

If Target.Column = 2 Then
Set TeamPic = Columns("P").Find(Target.Value).Offset(, 2)

For Each Pic In ActiveSheet.Pictures
If Pic.TopLeftCell.Address = Target.Offset(, -1).Address Then
Pic.Delete
GoTo NewPic
End If
Next

NewPic:

For Each Pic In ActiveSheet.Pictures
If Pic.TopLeftCell.Address = TeamPic.Address Then
Pic.Copy
Target.Offset(, -1).Activate
ActiveSheet.Paste
Target.Activate
Exit Sub
End If
Next
End If
End Sub
[/vba]

[Bob Phillips]

.

[zendog1960]

That worked exactly how I wanted it. I do have a question however. When you set the TeamPic = Columns("P")... can I create a 'Data' sheet to store this information and hide it from the user then call it up that way? Something like:

Set TeamPic = Worksheet("Data") Columns("P").Find(Target.Value).Offset(,2)

Would something like this work or do the images have to reside on the sheet inwhich I intend to show them?

Here's one method to try. Needs a bit more work!


[vba]Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim TeamPic As Range, Pic

If Target.Column = 2 Then
Set TeamPic = Columns("P").Find(Target.Value).Offset(, 2)

For Each Pic In ActiveSheet.Pictures
If Pic.TopLeftCell.Address = Target.Offset(, -1).Address Then
Pic.Delete
GoTo NewPic
End If
Next

NewPic:

For Each Pic In ActiveSheet.Pictures
If Pic.TopLeftCell.Address = TeamPic.Address Then
Pic.Copy
Target.Offset(, -1).Activate
ActiveSheet.Paste
Target.Activate
Exit Sub
End If
Next
End If
End Sub
[/vba]

[mdmackillop]

Revised file attached

[zendog1960]

That is awesome. Thank you so much! Let the fun begin!

Revised file attached