Solved

Determining the order of shape selection in a Delete Shapes macro

Posted on 2011-09-06
6
316 Views
Last Modified: 2012-05-12
I find that the macro below never starts with the uppermost left shape, but rather goes through every other shape in the active sheet BEFORE targeting the ones I want to delete. How do I get it to start with the left uppermost shape in the specified range and/or at least ignore any shape outside of the range?

Thanks,
John


Sub DeleteSomeShapes()
Dim shp As Shape, top As Range, btm As Range
Set top = [B2]
Set btm = Cells([A4] - 7, 18)
For Each shp In ActiveSheet.Shapes
    If Not Intersect(shp.TopLeftCell, Range(top, btm)) Is Nothing Then
    shp.Delete
    End If
Next shp
End Sub

Open in new window

0
Comment
Question by:gabrielPennyback
  • 3
  • 2
6 Comments
 
LVL 24

Expert Comment

by:StephenJR
ID: 36491923
Assuming A4 has the right number in it, if I test that code it only deletes shapes in the specified range.
0
 
LVL 1

Author Comment

by:gabrielPennyback
ID: 36492383
Hi Stephen, yes it does that for me too. It's just that I always have to run it on a bunch of sheets and it does slow things down a little, and every once in a while it bugs for some reason and testing it is annoyingly time-consuming.

Is there anyway to keep this kind of a macro from looking at all the extraneous shapes. What would be ideal would be something that says in effect: ActiveSheet.Range("B2:R100").DrawingObjects.Delete

Thanks,
John
0
 
LVL 80

Accepted Solution

by:
byundt earned 500 total points
ID: 36492505
John,
Assume that you have listened once again to my sermon on not selecting worksheets. Assume also that you have turned screen updating off. I believe that your code would run much faster in Excel 2003 as a result.

I rewrote your sub to have a worksheet parameter passed to it. This eliminates the need for it to be working on the active sheet. I then added a calling sub using a Select case

Sub DeleteSomeShapes(ws As Worksheet)
Dim shp As Shape, top As Range, btm As Range, rg As Range
With ws
    Set top = .[B2]
    Set btm = .Cells(.[A4] - 7, 18)
    Set rg = Range(top, btm)
    For Each shp In .Shapes
        If Not Intersect(shp.TopLeftCell, rg) Is Nothing Then
            shp.Delete
        End If
    Next shp
End With
End Sub

Sub CallingCode()
Dim ws As Worksheet
Application.ScreenUpdating = False
For Each ws In ActiveWorkbook.Worksheets
    Select Case LCase(ws.Name)
    Case "sheet1", "sheet3" 'Do nothing with these worksheets. Note that names should be lower case.
    Case Else
        DeleteSomeShapes ws
    End Select
Next
End Sub

Open in new window


Brad
0
IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

 
LVL 1

Author Comment

by:gabrielPennyback
ID: 36492596
Hi Brad, thanks. Rest assured I'm not selecting any sheets! At the moment I only need to delete shapes from the active sheet, but thank you for the additional code.

I'm probably making a mountain out of a mole hill, but for some reason this macro bugged this morning and I always test codes like this with cel.Select or shp.select so that I can see the steps it's going through. Whenever I have to do that, it just annoys me that this macro invariably selects all the shapes outside the desired range before getting to the ones that matter.

As soon as I can get back into my network drive I'll test this out to see if there's some tweak in your first code that will ignore the out of bounds shapes. If not, then I will do everything in my power to get out of denial and simply let mole hills be mole hills :-)

Thanks,
John
0
 
LVL 80

Assisted Solution

by:byundt
byundt earned 500 total points
ID: 36492743
John,
I was reacting to your statement "It's just that I always have to run it on a bunch of sheets and it does slow things down."

If you are only deleting shapes from the active sheet, then make sure you turn screen updating off before running the code. In a test deleting 281 shapes from a region on a worksheet, it made a 40% reduction in the time required.

If you ever might be deleting shapes from a non-active worksheet, then please use the sub I suggested with the worksheet parameter. It will work just as well when called like either of:
DeleteSomeShapes ActiveSheet
DeleteSomeShapes Worksheets("Sheet4")

Was the worksheet protected that had the problem with the code this morning? You need to unprotect it first.

Was cell A4 empty? It needs to have a value of 9 or more to be consistent with your code. You might change the statement setting range variable btm to:
    Set btm = .Cells(Application.Max(2, Val(.[A4]) - 7), 18)          'Works even if A4 is text or a number less than 9

If you knew the names of the shapes in the range of interest, you could delete just the names drawn from that list. One way of knowing the names is to set the name after you create the shape:
Dim shp As Shape
Set shp = Activesheet.Shapes(Activesheet.Shapes.Count)
shp.Name = "Rectangle" & shp.TopLeftCell.Address(False, False)      'Name it like RectangleB8

Brad
0
 
LVL 1

Author Closing Comment

by:gabrielPennyback
ID: 36498671
Great analysis and a wealth of useful info, thanks Brad!

- John
0

Featured Post

How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

Join & Write a Comment

A2 = A1 That kind of cell reference is relative.  If you copy it from A2 to B2, then B2 will get this: B2 = B1 That's all fine and good, but if you then insert a new row above row 2, you'll find: A3 = A1 B3 = B1 This is intentional. …
How to quickly and accurately populate Word documents with Excel data, charts and images (including Automated Bookmark generation) David Miller (dlmille) Synopsis In this article you’ll learn how to use ExcelToWord! to copy data,charts, shapes …
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
Graphs within dashboards are meant to be dynamic, representing data from a period of time that will change each time the dashboard is updated with new data. Rather than update each graph to point to a different set within a static set of data, t…

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now