Counting arrow shapes(up and down) using VBA code

Prashanth_Pasunuti

New Member
Joined
Jun 24, 2021
Messages
17
Office Version
  1. 2016
Platform
  1. Windows
Hello. I am new to VBA and i have been trying to count the no of up and down arrow shapes using VBA. I have tried to get the names of the arrows and then passed them to the user defined function so that it will tell whether the given name exists or not in EXCEL and count their repetition. But this did not work. Request to help me to get through.
Thanks in advance
 

Excel Facts

Excel Can Read to You
Customize Quick Access Toolbar. From All Commands, add Speak Cells or Speak Cells on Enter to QAT. Select cells. Press Speak Cells.
Try this:

VBA Code:
Dim shp As Shape, Osp As String, counter as long

For Each shp In ActiveSheet.Shapes
If shp.AutoShapeType = msoShapeUpArrow then 
counter = counter + 1
Elseif
shp.AutoShapeType = msoShapeUpDownArrow then
counter = counter + 1
End if
Next shp

MsgBox "There were :-" & counter & " Shapes"
 
Upvote 0
Try this:

VBA Code:
Dim shp As Shape, Osp As String, counter as long

For Each shp In ActiveSheet.Shapes
If shp.AutoShapeType = msoShapeUpArrow then
counter = counter + 1
Elseif
shp.AutoShapeType = msoShapeUpDownArrow then
counter = counter + 1
End if
Next shp

MsgBox "There were :-" & counter & " Shapes"
arrow_shapes.png

Sir i have applied the given code to this sheet but the counter value is 0. And the name of the arrows when i press alt + f10 were "Straight Arrow Connector --". -- represents 2 digit number.
 
Upvote 0
What are the shape types?

VBA Code:
Dim shp As Shape

For Each shp In ActiveSheet.Shapes
Debug.print shp.Type
Next shp
 
Upvote 0
Does this help?

VBA Code:
Sub CountArrowsws()
Dim Shp As Shape
Dim Ups As Integer
Dim Downs As Integer

For Each Shp In ActiveSheet.Shapes
With Shp
    If .Name Like ("Straight Arrow Connector" & "*") Then
        If .VerticalFlip = -1 Then
        Ups = Ups + 1
    Else
        Downs = Downs + 1
        End If
    End If
End With
Next Shp
'Do what you will with the totals ??
Range("A2") = Ups & " Up"
Range("B2") = Downs & "  Down"

End Sub
 
Upvote 0
Yes s
Does this help?

VBA Code:
Sub CountArrowsws()
Dim Shp As Shape
Dim Ups As Integer
Dim Downs As Integer

For Each Shp In ActiveSheet.Shapes
With Shp
    If .Name Like ("Straight Arrow Connector" & "*") Then
        If .VerticalFlip = -1 Then
        Ups = Ups + 1
    Else
        Downs = Downs + 1
        End If
    End If
End With
Next Shp
'Do what you will with the totals ??
Range("A2") = Ups & " Up"
Range("B2") = Downs & "  Down"

End Sub
yes sir this would really help me. Verticalflip property is giving true(-1) for only up arrow. Do we have any property that gives other than -1 value to indicate down arrow. This would finish my work.
 
Upvote 0
Surely, provided that the shape is of type 'Straight Arrow Connector' then, if it's not TRUE, (-1), for UP then, it's FALSE, (0), for DOWN ??????
 
Upvote 0
Surely, provided that the shape is of type 'Straight Arrow Connector' then, if it's not TRUE, (-1), for UP then, it's FALSE, (0), for DOWN ??????
Yes sir. But i have a problem with the names of the shapes in my excel sheet. There are cases where both lines and arrows are with same name as you can see in the image shared. So verticalflip property returns -1 for up arrows and it is returning 0 for both down arrows and lines. So i couldnt able to segregate down arrows from lines. Please help.
 
Upvote 0
That is not at all obvious to me from your image. Are your horizontal lines not 'Straight Connectors' ? If not then why not?
 

Attachments

  • Screenshot 2021-06-24 at 19.24.25.png
    Screenshot 2021-06-24 at 19.24.25.png
    86.7 KB · Views: 9
Upvote 0
The only other thing I can think of is to filter out your horizontal lines by virtue of their height?
Eg

VBA Code:
Sub CountArrowsws()
Dim Shp As Shape
Dim Ups As Integer
Dim Downs As Integer

For Each Shp In ActiveSheet.Shapes
With Shp
'************
If .Height < 1 Then GoTo Skip   'Skip a horizontal line that should have a height of zero ??
'************

    If .Name Like ("Straight Arrow Connector" & "*") Then
        If .VerticalFlip = -1 Then
        Ups = Ups + 1
    Else
        Downs = Downs + 1
        End If
    End If
End With
'************
Skip:
'************
Next Shp
'Do what you will with the totals ??
Range("A2") = Ups & " Up"
Range("B2") = Downs & "  Down"

End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,213,506
Messages
6,114,024
Members
448,543
Latest member
MartinLarkin

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