Deleting All Shapes Deletes Data Validation Forms

[melsahn]

Whats up guys? Just needed some help here with some code I would appreciate any help of course I just cant seem to figure this out...

What I am trying to do here is select a value from a drop down which is linked to a formula which triggers the macro shape..i have all that down already... but the problem is that I will have multiple values in the same drop down and I needed to figure a way to delete the previous macro shape in that range. And so i have created the delete all shapes code below but it seems whenever I use the code it deletes the data validation drop downs

here is what I have so far...



Function Macro()
'

DELETEALLSHAPES
'

'
ActiveSheet.Shapes.AddShape(msoShapeRectangle, 220.5, 105.75, 92.25, 51#). _
Select
End Function


Function CIRCLES()
'

DELETEALLSHAPES
'

'
ActiveSheet.Shapes.AddShape(msoShapeOval, 203.25, 101.25, 44.25, 34.5).Select
ActiveSheet.Shapes.AddShape(msoShapeOval, 267#, 102#, 28.5, 30#).Select
ActiveSheet.Shapes.AddShape(msoShapeOval, 246.75, 141#, 30.75, 27.75).Select
End Function


Sub DELETEALLSHAPES()
Set RNG = Range("E8:G14")
For Each SH In ActiveSheet.Shapes
If Not Application.Intersect(RNG, SH.TopLeftCell) Is Nothing Then
SH.Delete
End If
Next
End Sub

[mdmackillop]

Welcome to VBAX
Check for the shape name first

For Each sh In ActiveSheet.Shapes
'MsgBox sh.Name
If UCase(Left(sh.Name, 4)) <> "DROP" Then sh.selete
Next

[melsahn]

Thanks man but doesnt seem to work still and now actually doesnt activate the macro at all

[mdmackillop]

Can you post a sample workbook? Use Manage Attachments in the Go Advanced reply section.

[melsahn]

Sure here is an example workbook I just made...in this one the drop downs seem to be working but its not deleting the shape in the range or "replacing the previous shape" i should say

[mdmackillop]

Very puzzling! Try this for a workaround

Sub DELETEALLSHAPES()
Dim c As Range
Set Rng = Range("G25:K38")
On Error Resume Next
For Each sh In ActiveSheet.Shapes
Debug.Print sh.Name
Set c = Intersect(Rng, sh.TopLeftCell)
If Not c Is Nothing Then
If Left(sh.Name, 4) <> "Drop" Then sh.Delete
End If
Next
End Sub

[melsahn]

Thanks so much man it was really bugging me but now it works like a charm!