How to quickly delete shape data

[MikeB]

Just to take this a bit further :-)

...how can I delete all shape data in collection of shape apart from one specific field? i.e. I have about 200 shapes that all have the same fields - the first field is named 'AppID' and I want to keep this but delete all others. I guess I have to access at row name and test against that to exclude it?

Any help welcome :-)

[Surrogate]

Try this code please

Code

Sub MikeB()
Dim shp As Shape ' current shape
Dim sc As Section ' shp's shape data section
Dim rw As Row ' row in shape data section
Dim cnt As Integer ' count or rows in shape data section
Dim r As Integer ' counter
For Each shp In ActivePage.Shapes
If shp.SectionExists(visSectionProp, visExistsAnywhere) Then
' check for shape data section exist for current shape
Set sc = shp.Section(visSectionProp)
' define shape data section variable
cnt = sc.Count
' define how many rows in shape data section
For r = cnt - 1 To 1 Step -1
'iterate rows in section from last to second
' first row in Shape Data section don't delete
' rows index in Visio start from 0 !
Set rw = sc.Row(r)
' define row in shape data section variable
shp.DeleteRow sc.Index, rw.Index
' delete row in shape data section
Next
End If
Next
End Sub

[Jayehorn]

This has saved me so much time removing data but how can I re-add data?
I'm new to visio and currently using the newest visio version for office 365 apps.
I highlighted all the shapes and used my shortcut key for the macro and it removed on all shapedata at once. I then saved it.
I tried to re-add the shapedata but got the message to drag rows onto page to link data to existing shapes or to add new linked shapes.
Can you help me on this?

Thanks.

RuSty, I forgot about bug of Visio - when all section deleted and at once and new row. All old rows are return.
Try this code. There deleted not all section immediately, there deleted each row in this section!
If you prefer delete section via shapesheet, please save file after this operation, then deleted rows don't return in section

Code

Sub RuSty()
Dim sel As Selection
Dim sec As Section
Dim selsh As Shape
Set sel = ActiveWindow.Selection ' create "selection"
For x = 1 To sel.Count           ' iterate all shapes (from first to last) in selection
Set selsh = sel(x)               ' set current selected shape
For y = selsh.RowCount(visSectionProp) - 1 To 0 Step -1
selsh.DeleteRow visSectionProp, y ' in current shape delete current row in section "Shape Data"
Next y
Next x
End Sub

My English is little too

я забыл про этот баг Визио - если удалить секцию и тут же начать добавлять в нее строки. Все старые строки возвращаются
попробуй этот код, он удаляет не всю секцию, а каждую строку по очереди
Если ты предпочитаешь удалять секцию через Шейпшит, сразу же сохрани файл. Тогда удаленные строки не вернутся

[Surrogate]

I highlighted all the shapes and used my shortcut key for the macro and it removed on all shapedata at once. I then saved it.
I tried to re-add the shapedata but got the message to drag rows onto page to link data to existing shapes or to add new linked shapes.

Your shape data have external data links before delete ?

[Jayehorn]

I highlighted all the shapes and used my shortcut key for the macro and it removed on all shapedata at once. I then saved it.
I tried to re-add the shapedata but got the message to drag rows onto page to link data to existing shapes or to add new linked shapes.

Your shape data have external data links before delete ?

Yes. They are linked to an excel spreadsheet.