Counting Total Shape and specific shapes in excel

T

Trace

New Member
Joined
Sep 4, 2007
Messages
32
I am using excel 2003 to look at process flow. As part of this I am using excel’s flow chart shapes to diagram this flow. Some of the processes are quite extensive and there are multiple shapes which are placed onto our spreadsheets. What we need to be able to do is to count the total number of the shapes as well as to count certain shapes with certain characteristics, e.g. counting the flow chart process shapes that are colored yellow or counting the flow chart decision shapes colored aqua. Is there any function which can accomplish this or vba? Also some of these stock shapes may need to be altered by grouping other shapes with them and these may need to be counted. This all needs to be reported back to a cell e.g. A1. Any ideas? Thanks upfront for you assistance.

Sincerely,

Trace
 
Last edited:

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.
Sort by date Sort by votes
Hi, If you copy your sheet to a new sheet, then run this code in it. It will place an Autoshape Name next to each shape.
Then can then decide how you would like to collate all related shapes information.
Code: 
Dim shp As Shape, Osp As String, c

For Each shp In ActiveSheet.Shapes
   
Select Case shp.AutoShapeType
Case Is = msoShape24pointStar: Osp = "msoShape24pointStar"
Case Is = msoShape4pointStar: Osp = "msoShape4pointStar"
Case Is = msoShape8pointStar: Osp = "msoShape8pointStar"
Case Is = msoShapeActionButtonBeginning: Osp = "msoShapeActionButtonBeginning"
Case Is = msoShapeActionButtonDocument: Osp = "msoShapeActionButtonDocument"
Case Is = msoShapeActionButtonForwardorNext: Osp = "msoShapeActionButtonForwardorNext"
Case Is = msoShapeActionButtonHome: Osp = "msoShapeActionButtonHome"
Case Is = msoShapeActionButtonMovie: Osp = "msoShapeActionButtonMovie"
Case Is = msoShapeActionButtonSound: Osp = "msoShapeActionButtonSound"
Case Is = msoShapeBalloon: Osp = "msoShapeBalloon"
Case Is = msoShapeBentUpArrow: Osp = "msoShapeBentUpArrow"
Case Is = msoShapeBlockArc: Osp = "msoShapeBlockArc"
Case Is = msoShapeChevron: Osp = "msoShapeChevron"
Case Is = msoShapeCloudCallout: Osp = "msoShapeCloudCallout"
Case Is = msoShapeCube: Osp = "msoShapeCube"
Case Is = msoShapeCurvedDownRibbon: Osp = "msoShapeCurvedDownRibbon"
Case Is = msoShapeCurvedRightArrow: Osp = "msoShapeCurvedRightArrow"
Case Is = msoShapeCurvedUpRibbon: Osp = "msoShapeCurvedUpRibbon"
Case Is = msoShapeDonut: Osp = "msoShapeDonut"
Case Is = msoShapeDoubleBracket: Osp = "msoShapeDoubleBracket"
Case Is = msoShapeDownArrow: Osp = "msoShapeDownArrow"
Case Is = msoShapeDownRibbon: Osp = "msoShapeDownRibbon"
Case Is = msoShapeExplosion2: Osp = "msoShapeExplosion2"
Case Is = msoShapeFlowchartCard: Osp = "msoShapeFlowchartCard"
Case Is = msoShapeFlowchartConnector: Osp = "msoShapeFlowchartConnector"
Case Is = msoShapeFlowchartDecision: Osp = "msoShapeFlowchartDecision"
Case Is = msoShapeFlowchartDirectAccessStorage: Osp = "msoShapeFlowchartDirectAccessStorage"
Case Is = msoShapeFlowchartDisplay: Osp = "msoShapeFlowchartDisplay"
Case Is = msoShapeFlowchartDocument: Osp = "msoShapeFlowchartDocument"
Case Is = msoShapeFlowchartExtract: Osp = "msoShapeFlowchartExtract"
Case Is = msoShapeFlowchartInternalStorage: Osp = "msoShapeFlowchartInternalStorage"
Case Is = msoShapeFlowchartMagneticDisk: Osp = "msoShapeFlowchartMagneticDisk"
Case Is = msoShapeFlowchartManualInput: Osp = "msoShapeFlowchartManualInput"
Case Is = msoShapeFlowchartManualOperation: Osp = "msoShapeFlowchartManualOperation"
Case Is = msoShapeFlowchartMerge: Osp = "msoShapeFlowchartMerge"
Case Is = msoShapeFlowchartMultidocument: Osp = "msoShapeFlowchartMultidocument"
Case Is = msoShapeFlowchartOffpageConnector: Osp = "msoShapeFlowchartOffpageConnector"
Case Is = msoShapeFlowchartOr: Osp = "msoShapeFlowchartOr"
Case Is = msoShapeFlowchartPredefinedProcess: Osp = "msoShapeFlowchartPredefinedProcess"
Case Is = msoShapeFlowchartPreparation: Osp = "msoShapeFlowchartPreparation"
Case Is = msoShapeFlowchartProcess: Osp = "msoShapeFlowchartProcess"
Case Is = msoShapeFlowchartPunchedTape: Osp = "msoShapeFlowchartPunchedTape"
Case Is = msoShapeFlowchartSequentialAccessStorage: Osp = "msoShapeFlowchartSequentialAccessStorage"
Case Is = msoShapeFlowchartSort: Osp = "msoShapeFlowchartSort"
Case Is = msoShapeFlowchartStoredData: Osp = "msoShapeFlowchartStoredData"
Case Is = msoShapeFlowchartSummingJunction: Osp = "msoShapeFlowchartSummingJunction"
Case Is = msoShapeFlowchartTerminator: Osp = "msoShapeFlowchartTerminator"
Case Is = msoShapeFoldedCorner: Osp = "msoShapeFoldedCorner"
Case Is = msoShapeHeart: Osp = "msoShapeHeart"
Case Is = msoShapeHexagon: Osp = "msoShapeHexagon"
Case Is = msoShapeHorizontalScroll: Osp = "msoShapeHorizontalScroll"
Case Is = msoShapeIsoscelesTriangle: Osp = "msoShapeIsoscelesTriangle"
Case Is = msoShapeLeftArrow: Osp = "msoShapeLeftArrow"
Case Is = msoShapeLeftArrowCallout: Osp = "msoShapeLeftArrowCallout"
Case Is = msoShapeLeftBrace: Osp = "msoShapeLeftBrace"
Case Is = msoShapeLeftBracket: Osp = "msoShapeLeftBracket"
Case Is = msoShapeLeftRightArrow: Osp = "msoShapeLeftRightArrow"
Case Is = msoShapeLeftRightArrowCallout: Osp = "msoShapeLeftRightArrowCallout"
Case Is = msoShapeLeftRightUpArrow: Osp = "msoShapeLeftRightUpArrow"
Case Is = msoShapeLeftUpArrow: Osp = "msoShapeLeftUpArrow"
Case Is = msoShapeLightningBolt: Osp = "msoShapeLightningBolt"
Case Is = msoShapeLineCallout1: Osp = "msoShapeLineCallout1"
Case Is = msoShapeLineCallout1AccentBar: Osp = "msoShapeLineCallout1AccentBar"
Case Is = msoShapeLineCallout1BorderandAccentBar: Osp = "msoShapeLineCallout1BorderandAccentBar"
Case Is = msoShapeLineCallout1NoBorder: Osp = "msoShapeLineCallout1NoBorder"
Case Is = msoShapeLineCallout2: Osp = "msoShapeLineCallout2"
Case Is = msoShapeLineCallout2AccentBar: Osp = "msoShapeLineCallout2AccentBar"
Case Is = msoShapeLineCallout2BorderandAccentBar: Osp = "msoShapeLineCallout2BorderandAccentBar"
Case Is = msoShapeLineCallout2NoBorder: Osp = "msoShapeLineCallout2NoBorder"
Case Is = msoShapeLineCallout3: Osp = "msoShapeLineCallout3"
Case Is = msoShapeLineCallout3AccentBar: Osp = "msoShapeLineCallout3AccentBar"
Case Is = msoShapeLineCallout3BorderandAccentBar: Osp = "msoShapeLineCallout3BorderandAccentBar"
Case Is = msoShapeLineCallout3NoBorder: Osp = "msoShapeLineCallout3NoBorder"
Case Is = msoShapeLineCallout4: Osp = "msoShapeLineCallout4"
Case Is = msoShapeLineCallout4AccentBar: Osp = "msoShapeLineCallout4AccentBar"
Case Is = msoShapeLineCallout4BorderandAccentBar: Osp = "msoShapeLineCallout4BorderandAccentBar"
Case Is = msoShapeLineCallout4NoBorder: Osp = "msoShapeLineCallout4NoBorder"
Case Is = msoShapeMixed: Osp = "msoShapeMixed"
Case Is = msoShapeMoon: Osp = "msoShapeMoon"
Case Is = msoShapeNoSymbol: Osp = "msoShapeNoSymbol"
Case Is = msoShapeNotchedRightArrow: Osp = "msoShapeNotchedRightArrow"
Case Is = msoShapeNotPrimitive: Osp = "msoShapeNotPrimitive"
Case Is = msoShapeOctagon: Osp = "msoShapeOctagon"
Case Is = msoShapeOval: Osp = "msoShapeOval"
Case Is = msoShapeOvalCallout: Osp = "msoShapeOvalCallout"
Case Is = msoShapeParallelogram: Osp = "msoShapeParallelogram"
Case Is = msoShapePentagon: Osp = "msoShapePentagon"
Case Is = msoShapePlaque: Osp = "msoShapePlaque"
Case Is = msoShapeQuadArrowCallout: Osp = "msoShapeQuadArrowCallout"
Case Is = msoShapeRectangularCallout: Osp = "msoShapeRectangularCallout"
Case Is = msoShapeRightArrow: Osp = "msoShapeRightArrow"
Case Is = msoShapeRightBrace: Osp = "msoShapeRightBrace"
Case Is = msoShapeRightTriangle: Osp = "msoShapeRightTriangle"
Case Is = msoShapeRoundedRectangularCallout: Osp = "msoShapeRoundedRectangularCallout"
Case Is = msoShapeStripedRightArrow: Osp = "msoShapeStripedRightArrow"
Case Is = msoShapeTrapezoid: Osp = "msoShapeTrapezoid"
Case Is = msoShapeUpArrowCallout: Osp = "msoShapeUpArrowCallout"
Case Is = msoShapeUpDownArrowCallout: Osp = "msoShapeUpDownArrowCallout"
Case Is = msoShapeUTurnArrow: Osp = "msoShapeUTurnArrow"
Case Is = msoShapeWave: Osp = "msoShapeWave"
Case Is = msoShape16pointStar: Osp = "msoShape16pointStar"
Case Is = msoShape32pointStar: Osp = "msoShape32pointStar"
Case Is = msoShape5pointStar: Osp = "msoShape5pointStar"
Case Is = msoShapeActionButtonBackorPrevious: Osp = "msoShapeActionButtonBackorPrevious"
Case Is = msoShapeActionButtonCustom: Osp = "msoShapeActionButtonCustom"
Case Is = msoShapeActionButtonEnd: Osp = "msoShapeActionButtonEnd"
Case Is = msoShapeActionButtonHelp: Osp = "msoShapeActionButtonHelp"
Case Is = msoShapeActionButtonInformation: Osp = "msoShapeActionButtonInformation"
Case Is = msoShapeActionButtonReturn: Osp = "msoShapeActionButtonReturn"
Case Is = msoShapeArc: Osp = "msoShapeArc"
Case Is = msoShapeBentArrow: Osp = "msoShapeBentArrow"
Case Is = msoShapeBevel: Osp = "msoShapeBevel"
Case Is = msoShapeCan: Osp = "msoShapeCan"
Case Is = msoShapeCircularArrow: Osp = "msoShapeCircularArrow"
Case Is = msoShapeCross: Osp = "msoShapeCross"
Case Is = msoShapeCurvedDownArrow: Osp = "msoShapeCurvedDownArrow"
Case Is = msoShapeCurvedLeftArrow: Osp = "msoShapeCurvedLeftArrow"
Case Is = msoShapeCurvedUpArrow: Osp = "msoShapeCurvedUpArrow"
Case Is = msoShapeDiamond: Osp = "msoShapeDiamond"
Case Is = msoShapeDoubleBrace: Osp = "msoShapeDoubleBrace"
Case Is = msoShapeDoubleWave: Osp = "msoShapeDoubleWave"
Case Is = msoShapeDownArrowCallout: Osp = "msoShapeDownArrowCallout"
Case Is = msoShapeExplosion1: Osp = "msoShapeExplosion1"
Case Is = msoShapeFlowchartAlternateProcess: Osp = "msoShapeFlowchartAlternateProcess"
Case Is = msoShapeFlowchartCollate: Osp = "msoShapeFlowchartCollate"
Case Is = msoShapeFlowchartData: Osp = "msoShapeFlowchartData"
Case Is = msoShapeFlowchartDelay: Osp = "msoShapeFlowchartDelay"
Case Is = msoShapeQuadArrow: Osp = "msoShapeQuadArrow"
Case Is = msoShapeRectangle: Osp = "msoShapeRectangle"
Case Is = msoShapeRegularPentagon: Osp = "msoShapeRegularPentagon"
Case Is = msoShapeRightArrowCallout: Osp = "msoShapeRightArrowCallout"
Case Is = msoShapeRightBracket: Osp = "msoShapeRightBracket"
Case Is = msoShapeRoundedRectangle: Osp = "msoShapeRoundedRectangle"
Case Is = msoShapeSmileyFace: Osp = "msoShapeSmileyFace"
Case Is = msoShapeSun: Osp = "msoShapeSun"
Case Is = msoShapeUpArrow: Osp = "msoShapeUpArrow"
Case Is = msoShapeUpDownArrow: Osp = "msoShapeUpDownArrow"
Case Is = msoShapeUpRibbon: Osp = "msoShapeUpRibbon"
Case Is = msoShapeVerticalScroll: Osp = "msoShapeVerticalScroll"
End Select
c = c + 1
'MsgBox "Selected Shape Autoshape Type / Name / Number are :- " & Chr(10) & Osp & " / " & shp.Name & " / " & shp.AutoShapeType

shp.BottomRightCell = Osp
Next shp

MsgBox "There were :-" & Shapes.Count & " Shapes"
Regards Mick
 
Upvote 0
MickG,

Wow, it works quite well. I did have to change the last line of code from MsgBox "There were :-" & Shapes.Count & " Shapes" to MsgBox "There were :-" & Shape.Count & " Shapes" to have it ID the names. Also the message box feature gave me a run time error of 424, and I'm not quite sure what to do there to obtain the total shape count. It does post the names of the objects and of course with a countif I can do a count of the text so that works swimmingly. Is there also any way for it to distinguish other features of the objects such as with the: Case Is = msoShapeFlowchartCard: Osp = "msoShapeFlowchartCard" to have it distinguish cards of a certain color? What you have done will save me significant time.

Many Thanks

Trace
 
Upvote 0
Hi, Try this, it will Name the "FlowchartCards" with there name and Colour and also give you a Msgbox with Details.
You could mod it for other Shape types.
Code: 
Dim shp As Shape, Col As String, oCol As Integer
For Each shp In ActiveSheet.Shapes
   If shp.AutoShapeType = msoShapeFlowchartProcess Then
       oCol = shp.Fill.ForeColor.SchemeColor
        Col = Col & shp.Name & " / " & oCol & Chr(10)
         shp.BottomRightCell.Offset(1) = shp.Name & "/ Colour " & oCol
        End If
   Next shp
MsgBox "ShapeFlowchartProcess.Name / Colour  = " & Chr(10) & Col
Regards Mick
 
Upvote 0
I had to use: MsgBox (ActiveSheet.Shapes.Count) instead of MsgBox (Shapes.Count).

User Trace made a remark Oct 29th 2008 that didn't work for me.

I placed the code in a Sub-procedure and invoked it as a macro from within the WorkSheet to be reported.
Used version = Excel 2007
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

M
  • Question
Workbook Event Macros Triggering in Other Workbooks
Replies
7
Views
824
Anthony P Rose
A
J
  • Question
Not sure if Excel can do this...
Replies
1
Views
549
Sam_D_Ben
S
S
  • Solved
Modify script to provide totals that isnt always in the same location
Replies
2
Views
502
smozgur
smozgur
E
  • Question
Create mails with table - standard header specific row
Replies
1
Views
919
esben
E
4
  • Question
VBA - Dynamic Cell Shifting
Replies
4
Views
1K
4EverStudent
4

Forum statistics

Threads
1,214,375
Messages
6,119,168
Members
448,870
Latest member
max_pedreira

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top