Picture Copy/Insert Based on Cell Value

[ryan_law2000]

Hello, I cant seem to get anything to work for this.

If Sheet1 A5 = "TEST A"
Delete current picture in $A$7
Then Copy "Picture 1" from Sheet2
Insert Picture into sheet1$A$7

If Sheet1 A5 = "TEST B"
Delete current picture in $A$7
Then Copy "Picture 2" from Sheet2
Insert Picture into sheet1$A$7

I have about 50 possible picture so i would continue on from there

Any ideas on how this could be done?

 

[Domenic]

First, set up a table that lists the test (ie. TEST A), along with the corresponding picture name (ie. Picture 1). For this example, let's assume that Sheet2 contains this list in A2:B50, as follows...

TEST A	Picture 1
TEST B	Picture 2
etc...

<COLGROUP><COL style="WIDTH: 74pt; mso-width-source: userset; mso-width-alt: 3584" span=2 width=98><TBODY>
</TBODY>

Then try the following macro...

Option Explicit
Sub InsertPicture()
    Dim objPic      As Picture
    Dim wksSource   As Worksheet
    Dim wksDest     As Worksheet
    Dim varPicName  As Variant
    
    Set wksSource = Worksheets("Sheet2")
    Set wksDest = Worksheets("Sheet1")
    
    varPicName = Application.VLookup(wksDest.Range("A5").Value, wksSource.Range("A2:B50"), 2, 0)
    
    If IsError(varPicName) Then
        MsgBox "The picture is not available.", vbExclamation
        Exit Sub
    End If
    
    For Each objPic In wksDest.Pictures
        If objPic.TopLeftCell.Address = "$A$7" Then
            objPic.Delete
            Exit For
        End If
    Next objPic
    
    wksSource.Pictures(varPicName).Copy
    wksDest.Range("A7").PasteSpecial
    
End Sub

Hope this helps!