Sub YWN()
  Dim sp, rg As Range, c As Range, d, nm$
  For Each sp In ActiveSheet.Shapes
    If InStr("YesWaitingNoButon", sp.Name) = 0 Then sp.Delete
  Next
  Set rg = Intersect(ActiveSheet.UsedRange, _
    Columns(8).Resize(, Columns.Count - 7), _
    Rows(3).Resize(Rows.Count - 2))
  On Error Resume Next
  Set rg = rg.SpecialCells(xlCellTypeConstants)
  If Err Then Exit Sub Else On Error GoTo 0
  Set d = CreateObject("Scripting.Dictionary")
  For Each sp In ActiveSheet.Shapes: d(sp.Name) = 0: Next
  For Each c In rg
    nm = Cells(c.Row, 7)
    If d.exists(nm) Then
      ActiveSheet.Shapes(nm).Copy: ActiveSheet.Paste
      d(nm) = d(nm) + 1
      With Selection
        .Name = .Name & d(nm): .Top = c.Top: .Left = c.Left
      End With
    End If
  Next
End Sub