Calculate range instead of single cell

[robseitz74]

I have this code that works great on a single cell but I want to apply it to a range of cells and can't seem to get it to work. Any assistance with this would be wonderful as I am creating something for work and this is the last step I need to overcome to complete the project! The code I'm starting with is:

Private Sub Worksheet_Calculate()
Dim oPic As Picture
Me.Pictures.Visible = False
With Range("J5")
For Each oPic In Me.Pictures
If oPic.Name = .Text Then
oPic.Visible = True
oPic.Top = .Top
oPic.Left = .Left
Exit For
End If
Next oPic
End With
End Sub

Thank you for any and all guidance as I am still new to excel and learning my way around. The issue is line 4 (With Range) if I change J5 to the range of cells I'm looking to use it on it no longer returns the pic for any cell.

 

[GWteB]

Try this

Private Sub Worksheet_Calculate()
    Dim oPic As Picture
    Dim c    As Range
    
    Me.Pictures.Visible = False
    For Each c In Range("J5:H10")
        For Each oPic In Me.Pictures
            If oPic.Name = c.Text Then
                oPic.Visible = True
                oPic.Top = .Top
                oPic.Left = .Left
            End If
        Next oPic
    Next
End Sub

 

[robseitz74]

GWteB This looks like what I'm trying to accomplish but it gives me a compile error: Invalid or unqualified reference. I was able to get it to work by tweaking what you sent as follows:

Private Sub Worksheet_Calculate()
    Dim oPic As Picture
    Dim c    As Range
    
    Me.Pictures.Visible = False
    For Each c In Range("J5:H10")
        For Each oPic In Me.Pictures
            If oPic.Name = c.Text Then
                oPic.Visible = True
                oPic.Top = c.Top
                oPic.Left = c.Left
            End If
        Next oPic
    Next
End Sub

Now the only issue is I am only getting column J to work and if I repeat a value it will only display the pic in one location.

 

[robseitz74]

I was able to fix the column issue (user error) I fat fingured my entry. Still can't repeat a value but everything else is working great.

 

[robseitz74]

@GWteB If I use the same value twice it will only display the image for the last entry, any advice on how I can resolve that?

 

[GWteB]

It would be helpful if you would describe your goal step by step. What do you expect from the code, what should the code do and what not.

 

[robseitz74]

It would be helpful if you would describe your goal step by step. What do you expect from the code, what should the code do and what not.

I'm building a master scorecard for a land navigation course. When they go to a point there is a punch with a symbol on it. They write down the point number and punch their card with the punch. The master scorecard will be used to grade their scorecard. We have as many as 100 people going at a time so my spreadsheet should allow us to input all their points and bring a picture of the punch pattern that coincides with that point number.

 

[GWteB]

That's not what I meant. You're giving me a description of your project, what it is for. Would you like to describe the expected program flow of the code?

 

[robseitz74]

That's not what I meant. You're giving me a description of your project, what it is for. Would you like to describe the expected program flow of the code?

So if I'm understanding you correctly what I'm trying to do is enter a number between 1 and 60 in cell F5 and doing so will bring up the pic in cell J5 that coincides with that number. Numbers will repeat so if I enter the same number in F25 I need J25 to display the same image. Currently what happens is J25 displays it and it gets removed from J5. I have a table built that associates the numbers to the pics and in the J column I use =VLOOKUP(F5, PIC, 2, FALSE).

 

[GWteB]

Inventive idea and yet another alternative use of Excel, nice.
I think it is clear to me, summarizing:
- all pictures to be used are on the worksheet where the numbers are entered;
- the Vlookup formula is on that same worksheet, four columns ahead;
- each picture must have the possibility to be visible several times at the same time;
- if a new number is entered the new picture replaces the previous one, just one picture at a time upon one cell.
Based on this scenario I wrote the code, leaving some comments for better understanding. Three procedures are involved. Instead of the Worksheet Calculation event procedure I used the Worksheet Change event. In case you already have a Worksheet Change event procedure, code can easily be merged. For sake of simplicity the duplicate pictures are not "memorized" which means whenever a duplicate manually has been moved it also has to be deleted manually. In case of any issue regarding this topic, do let me know.
This goes in the worksheet module:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r   As Range
    Set r = Application.Intersect(Target, Me.Range("F5:F104"))
    If Not r Is Nothing Then
        ' the value of any cell within range F5:F104 has been changed, so ...
        ' invoke desired action
        Call GetPicture(Target)
    End If
End Sub

This goes in a standard module (within VBE: menu > Insert > Module):

Public Function PictureExists(ByRef argSht As Worksheet, ByRef argPict As String) As Boolean
    Dim oPict
    For Each oPict In argSht.Pictures
        If StrComp(oPict.Name, argPict, vbTextCompare) = 0 Then
            PictureExists = True
            Exit For
        End If
    Next
End Function

Public Sub GetPicture(ByRef argTarget As Range)
    Dim raTmp       As Range
    Dim raPict      As Range
    Dim oPict       As Picture

    ' backup so current cell can be restored
    Set raTmp = ActiveCell
    
    ' VLOOKUP is on same row, 4 columns ahead, ie Columns("J")
    ' and is expected to contain the picture name
    Set raPict = argTarget.Offset(0, 4)

    ' delete previous picture (if there is any...)
    For Each oPict In argTarget.Parent.Pictures
        If oPict.TopLeftCell.Address = raPict.Address Then
            oPict.Delete
            Exit For
        End If
    Next

    ' obtain picture name and perform copy / paste
    ' some precautions are taken to prevent Run-time errors
    With argTarget
        If Not IsEmpty(raPict) And Not IsError(raPict) And Not IsNumeric(raPict) Then
            If PictureExists(raPict.Parent, raPict.Value) Then
                .Parent.Pictures(raPict.Value).Copy
                raPict.Select
                .Parent.Paste
            End If
        End If
    End With
    
    'restore
    raTmp.Select
End Sub