Show Two Pics based on value of two cells

[asad]

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

 

[asad]

All VBA Gurus, can somebody please help?

 

[Tom Urtis]

Does this do what you want?

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

 

[asad]

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

 

[Tom Urtis]

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.

 

[asad]

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

 

[Tom Urtis]

Replace the last code I posted with this and see if it does the dirty deed.

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

 

[asad]

Yes, That's the one.

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

Thanks again
Asad