hi.
copy the follwing code to Workseet("DATA") code module.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim shp As Shape
Dim day_sel As Range
Set day_sel = Range("Day_Selection")
If Intersect(Target, day_sel) Is Nothing Then Exit Sub
On Error GoTo sel_day
For Each shp In Shapes
If Not Intersect(shp.TopLeftCell, Range("F18")) Is Nothing Then shp.Delete
Next shp
sel_day:
Select Case day_sel
Case 1
ActiveSheet.Shapes("Quad Arrow 1").Select
Selection.Copy
Range("days_Cells").Select
ActiveSheet.PasteSpecial Format:="Picture (PNG)", Link:=False, _
DisplayAsIcon:=False
Case 2
ActiveSheet.Shapes("Bent-Up Arrow 2").Select
Selection.Copy
Range("days_Cells").Select
ActiveSheet.PasteSpecial Format:="Picture (PNG)", Link:=False, _
DisplayAsIcon:=False
Case 3
ActiveSheet.Shapes("AutoShape 18").Select
Selection.Copy
Range("days_Cells").Select
ActiveSheet.PasteSpecial Format:="Picture (PNG)", Link:=False, _
DisplayAsIcon:=False
Case 4
ActiveSheet.Shapes("Down Arrow 4").Select
Selection.Copy
Range("days_Cells").Select
ActiveSheet.PasteSpecial Format:="Picture (PNG)", Link:=False, _
DisplayAsIcon:=False
Case 5
ActiveSheet.Shapes("12-Point Star 5").Select
Selection.Copy
Range("days_Cells").Select
ActiveSheet.PasteSpecial Format:="Picture (PNG)", Link:=False, _
DisplayAsIcon:=False
End Select
End Sub