VBA - Copy/Paste Shape - Issue

S

Spaztic

New Member
Joined
Jul 27, 2023
Messages
39
Office Version
  1. 365
Platform
  1. Windows
Hoping there is an easy solution. I want the shape (arrow) to be copied into any cell that gets selected.
  • Selected cell B2
  • Click on the arrow in B1 (macro)
  • Code is run to copy the arrow in B1 and place in B2 (the selected cell)
1716739390283.png


This seems to work ok UNLESS I select a cell that contains a dropdown BEFORE I select B2. Clicking Debug shows .OnAction = "" is an issue in my code
1716739088743.png


I noticed that in the selection pane, when I click from A2 (dropdown cell) to B2...it adds 'Drop Down 20'. This seems to be an issue. I can click SAVE and this 'Drop Down 20' goes away and everything works again.
1716739176018.png


Is there anything that can be added/modified in the code below so that 'Drop Down 20' (or whatever cell with a drop down was selected at some point) goes away when clicking on the 'arrow' (macro)?

VBA Code: 
Sub Arrow()
    Dim Sh As Shape
  
    With ActiveSheet
        ActiveCell.Activate
   
        .Shapes("Arrow").Copy
        .Paste 'inital position at selected cell
        Set Sh = .Shapes(.Shapes.Count) 'the newest shape
    End With
     
    With Sh
        Sh.Name = "Arrow2"
                      
        .OnAction = ""
       
    End With
End Sub
 

Attachments

  • 1716738603789.png
    1716738603789.png
    2.8 KB · Views: 0
  • 1716738634472.png
    1716738634472.png
    3 KB · Views: 0

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Sort by date Sort by votes
I cannot reproduct it consistently, but somehow your drop down (which contains a type 8 shape) get's added as the last element of the shapes collection so that this statement

VBA Code: 
 Set Sh = .Shapes(.Shapes.Count)               'the newest shape

Gets assigned to the drop down instead of the new arrow. This workaround might be an alternative:

VBA Code: 
Sub Arrow()
    Dim Sh As Shape, ShSrc As Shape
    Dim I As Long

    With ActiveSheet
        Set ShSrc = .Shapes("Arrow")
        ShSrc.Copy
        .Paste                                        'inital position at selected cell

        Set Sh = .Shapes(.Shapes.Count)               'the newest shape

        If Sh.Type <> ShSrc.Type Then                 'fallback logic for when last element is not an arrow
            For I = .Shapes.Count To 1 Step -1
                Set Sh = .Shapes(I)
                If Sh.Type = ShSrc.Type Then
                    If (Sh.Name = ShSrc.Name) And (Sh.Top + Sh.Left) <> (ShSrc.Top + ShSrc.Left) Then
                        Exit For
                    End If
                End If
                Set Sh = Nothing
            Next I
        End If
    End With

    If Not Sh Is Nothing Then
        With Sh
            Sh.Name = "Arrow2"
            .OnAction = ""
        End With
    End If
End Sub
 
Last edited:
Upvote 0
Solution
You could also delete this line. It's redundant.

VBA Code: 
ActiveCell.Activate

ActiveCell is by definition already active.
 
Upvote 0
You must log in or register to reply here.

Similar threads

S
  • Solved
VBA Code - Rename copied shape
Replies
1
Views
42
KOKOSEK
KOKOSEK
L
  • Solved
Worksheet Change_Event not working on cell value change
Replies
9
Views
213
Lil Stinker
L
C
  • Question
Daily Run data (copy data in loop by daily in worksheet)
Replies
3
Views
232
dermie_72
D
T
  • Solved
VBA- Copy & Paste Range into Outlook as a Picture
Replies
6
Views
381
jolivanes
jolivanes
C
  • Question
Delete Cell Range, or Add Range and Copy Formulas etc. - Excel VBA
Replies
0
Views
172
CSTjr
C

Forum statistics

Threads
1,216,500
Messages
6,131,015
Members
449,615
Latest member
Nic0la

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