Show Two Pics based on value of two cells

asad

Well-known Member
Joined
Sep 9, 2008
Messages
1,434
Hello,

I got the following code from this forum itself that works great:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oPic As Picture
Me.Pictures.Visible = False
If Target.Address <> "$A$1"Then Exit Sub
With Range("A1")
For Each oPic In Me.Pictures
If oPic.Name = .Text Then
With Range("A10")
oPic.Visible = True
oPic.Top = .Top
oPic.Left = .Left
End With
Exit For
End If
Next oPic
End With
End Sub
But when I change it to the following code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oPic As Picture
Me.Pictures.Visible = False
If Target.Range <> ("$A$1""$J$1") Then Exit Sub
With Range("A1")
For Each oPic In Me.Pictures
If oPic.Name = .Text Then
With Range("A10")
oPic.Visible = True
oPic.Top = .Top
oPic.Left = .Left
End With
Exit For
End If
Next oPic
End With
With Range("J1")
For Each oPic In Me.Pictures
If oPic.Name = .Text Then
With Range("J10")
oPic.Visible = True
oPic.Top = .Top
oPic.Left = .Left
End With
Exit For
End If
Next oPic
End With
End Sub

It does not work with cell J1. I am not sure what do i have to do to make it work. I want both pictures to show up when two different values are selected in those two cells.

Thanks
Asad
 
Last edited:

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
Does this do what you want?


Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oPic As Picture
Me.Pictures.Visible = False

With Target
Select Case .Address

Case "$A$1"
For Each oPic In Me.Pictures
If oPic.Name = .Text Then

With Range("A10")
oPic.Visible = True
oPic.Top = .Top
oPic.Left = .Left
End With
Exit For
End If
Next oPic

Case "$J$1"
For Each oPic In Me.Pictures
If oPic.Name = .Text Then
With Range("J10")
oPic.Visible = True
oPic.Top = .Top
oPic.Left = .Left
End With
Exit For
End If
Next oPic

End Select
End With
End Sub
 
Upvote 0
Thanks for the answer Tom.
It is beautiful. But why does the first picture disappear when I select the other one?
Is it possible for both pictures to stay if I got two different values in both cells? If either one does not have a vlaue, then of course only one picture will show up.
Is it possible?
Thanks a lot.
Asad
 
Upvote 0
Thanks for the answer Tom.
It is beautiful. But why does the first picture disappear when I select the other one?

Because that was what your original code was doing. Notice in your first post, before anything else, immediately below both Sub lines you are hiding all pictures as soon as anything is changed.


Is it possible for both pictures to stay if I got two different values in both cells? If either one does not have a vlaue, then of course only one picture will show up. Is it possible?

Yes it is possible but a little confusing. Explain your potential scenarios so this can get nailed down the way you want. Does "two different" mean two unequal, or just each cell (A1 and J1) having some value.
 
Upvote 0
I will try to explain a bit more.

I will have either one vlaue in one of the cells (A1, J1) or two different values in them. It will never be same value in both cells, unless they are empty.
So can I have the picture or pictures to show up corressponding to the values in cells?
  1. If there is a value in A1 but nothing in J1, only one picture will show in A10
  2. If A1 is blank, but J1 has a value, then that picture will show in J10
  3. If both A1 and J1 have values, both pictures should show up in A10 and J10 respectively
  4. If boh are empty, no picture to show
Thanks
Asad
 
Upvote 0
Replace the last code I posted with this and see if it does the dirty deed.


Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim oPic As Picture
Me.Pictures.Visible = False

With Target
Select Case Target.Address

Case "$A$1"
For Each oPic In Me.Pictures
If oPic.Name = .Text Then

With Range("A10")
oPic.Visible = True
oPic.Top = .Top
oPic.Left = .Left
End With
Exit For
End If
Next oPic
If Len(Range("J1").Value) > 0 Then _
ActiveSheet.Pictures(Range("J1").Text).Visible = True
 
Case "$J$1"
For Each oPic In Me.Pictures
If oPic.Name = .Text Then
With Range("J10")
oPic.Visible = True
oPic.Top = .Top
oPic.Left = .Left
End With
Exit For
End If
Next oPic
If Len(Range("A1").Value) > 0 Then _
ActiveSheet.Pictures(Range("A1").Text).Visible = True

End Select
End With
End Sub
 
Upvote 0
Yes, That's the one.

Thanks a lot Tom.
It does all the dirty work for me:biggrin:

Thanks again
Asad
 
Upvote 0

Forum statistics

Threads
1,213,560
Messages
6,114,306
Members
448,564
Latest member
ED38

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