Collect or not to collect

showard1

New Member
Joined
Aug 5, 2010
Messages
14
Hi allI have a little challenge.I have a VBA routing that inserts a series of objects (simple shapes) in specific places on a worksheet according to a number of user inputs. in each instance I know the name of each object, and it is suffixed with a sequential number which I also have control of ieshaperange.name = "bar" & i where i is a sequential integer, and does not finish at a set max valueSimple so far.The problem I am having is to work out how to delete all the shapes at the start of a new session. I cant "select all" as there are some objects (shapes) that I dont want deleted.The first idea I had was to place them in a collection, which works as far as adding to the collection, but I cant then work out a way to then select the objects in the collection to delete them. Secondly I dont know if the objects stay in the collection once the macro routine has stopped running.Alternatively I could consider adding them to a group as I go, but this begs, a can you sequentially add to a group, and secondly can I force the group name as I can an object name.Alternatively I am missing an easier route. Many thanks in advance for anyone who can guide me.Si
 

Some videos you may like

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
Welcome to the Board.

If you know part of the shapes' names you can loop around them all and test the name with the Instr function or the Like operator before deleting.
 

Yard

Well-known Member
Joined
Nov 5, 2008
Messages
1,929
Maybe
Code:
Sub DeleteShapes()
Dim shp As Shape
For Each shp In ActiveSheet.Shapes
    If Left(shp.Name, 3) = "bar" Then
        If IsNumeric(Trim(Right(shp.Name, Len(shp.Name) - Len("bar")))) Then
            shp.Delete
        End If
    End If
Next shp
End Sub
 

showard1

New Member
Joined
Aug 5, 2010
Messages
14
Thanks that routine worked fine, I am thinking still about using the routine to group or "collect" the objects together into one element, so that the initialisation routine (deleting) is quicker. any ideasSimon
 

Yard

Well-known Member
Joined
Nov 5, 2008
Messages
1,929

ADVERTISEMENT

Thanks that routine worked fine, I am thinking still about using the routine to group or "collect" the objects together into one element, so that the initialisation routine (deleting) is quicker. any ideasSimon
Silly question, but if it works then what's driving the need to do something else? Is this method too slow?

Seems like overkill to create a collection of objects, when the single fate of that collection is to be immediately deleted!

:)
 

showard1

New Member
Joined
Aug 5, 2010
Messages
14
YardOK I need to explain a little further.The application is a timed process, that has a ticker for the user. Once they start, they have predeterminded time to complete the task, and its that task that puts up the different shape elements.My thinking was that if I grouped the shapes at the end of the process, when I came up with a new instance of the routine, there would be a single "delete" instance, as the clock started running, rather than the looping multiple "check and delete".The other option I guess is a separate "clear" then "start" processThanks for your input so far.Si
PS why are my carriage returns not showing in the posting ?
 

Yard

Well-known Member
Joined
Nov 5, 2008
Messages
1,929
Still don't understand, but try this to create a ShapeRange object containing the relevant shapes:

Code:
Sub DeleteShapesArray()
Dim oShp As Shape, oShpR As ShapeRange
Dim wks As Worksheet
Dim vShapes()
Dim i As Integer
Const sID As String = "bar"
Set wks = ActiveSheet
For Each oShp In wks.Shapes
    If Left(oShp.Name, Len(sID)) = sID Then
        If IsNumeric(Trim(Right(oShp.Name, Len(oShp.Name) - Len(sID)))) Then
            i = i + 1
            ReDim Preserve vShapes(1 To i)
            vShapes(i) = oShp.Name
        End If
    End If
Next oShp
If Not IsArrayEmpty(vShapes) Then
    Set oShpR = wks.Shapes.Range(vShapes)
End If
If Not oShpR Is Nothing Then
    oShpR.Delete
End If
End Sub
 
Function IsArrayEmpty(a As Variant) As Boolean
'function from jindon
    IsArrayEmpty = Len(Join(a, "")) = 0
End Function
 
Last edited:

Subscribe on YouTube

Watch MrExcel Video

Forum statistics

Threads
1,106,452
Messages
5,511,463
Members
408,850
Latest member
NewUserPri

This Week's Hot Topics

  • Turn fraction around
    Hello I need to turn a fraction around, for example I have 1/3 but I need to present as 3/1
  • TIme Clock record reformatting to ???
    Hello All, I'd like some help formatting this (Tbl-A)(Loaded via Power Query) [ATTACH type="full" width="511px" alt="PQdata.png"]22252[/ATTACH]...
  • TextBox Match
    hi, I am having a few issues with my code below, what I need it to do is when they enter a value in textbox8 (QTY) either 1,2 or 3 the 3 textboxes...
  • Using Large function based on Multiple Criteria
    Hello, I can't seem to get a Large formula to work based on two criteria's. I can easily get a oldest value based one value, but I'm struggling...
  • Can you check my code please
    Hi, Im going round in circles with a Compil Error End With Without With Here is the code [CODE=rich] Private Sub...
  • Combining 2 pivot tables into 1 chart
    Hello everyone, My question sounds simple but I do not know the answer. I have 2 pivot tables and 2 charts that go with this. However I want to...
Top