Code to image in cell automatically?

[Tarheel8181]

See attached. I need a code that will make the icon appear automatically on this tab in column C in the appropriate row if Column A on the Records tab has a "Yes" entry. Any thoughts?

 

[Luke M]

Here ya go. Make sure to change references at beginning as needed.

Sub MakeIcons()
Dim sh As Shape, myShape As Shape
Dim lastRow As Long, i As Long
Dim pasteRange As Range
Dim searchRange As Range

'Define our reference points
Set sh = Worksheets("Icon").Shapes("Picture 1")
Set searchRange = Worksheets("Records").Range("B2:B100")

Application.ScreenUpdating = False
With Worksheets("Need Formula")
    'Clear out any old shapes
    For Each myShape In .Shapes
        myShape.Delete
    Next myShape
       
    lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    sh.Copy
    For i = 2 To lastRow
        If UCase(searchRange.Find(.Cells(i, "A").Value).Offset(0, -1).Value) = "YES" Then
            Set pasteRange = .Cells(i, "C")
            .Paste pasteRange
            Set myShape = .Shapes(.Shapes.Count)
            'Resize the icons to fit
            myShape.Height = pasteRange.Height * 0.9
            'Center horizontally
            myShape.Left = pasteRange.Left + pasteRange.Width / 2 - myShape.Width / 2
            myShape.Top = pasteRange.Top + 1
        End If
    Next i
    .Select
    .Range("A1").Select
End With
Application.ScreenUpdating = True
           
End Sub

 

[Faseeh]

Hi Tarheel,

Try this:

=IF(INDEX(Records!$A$2:$A$5,MATCH(A2,Records!$B$2:$B$5,0))="YES",CHAR(74),"")

And change font to Webdings.

 

[dramnath1981]

Its amazing to see some great answers. I was also trying to find some solution. But I could only think of a simple solution as below.

In Wingdings Font, letter "J" will give you this Smiley symbol. So, you can simply replace "Yes" with "J" and change the font from Calibri to Wingdings which will give you the smiley.