VBA Code Problem

hrayani

Well-known Member
Joined
Jul 23, 2010
Messages
1,549
Office Version
  1. 2016
Platform
  1. Windows
Hello Friends,

The below VBA code is assigned to 6 shapes which runs perfectly fine when I click the shape

But When I try to run it without clicking the shape (directly from the VBA window with F5 key or calling with Application.Run in the worksheet activate event, then it states that the item with the specified name does not found with below line highlighted in yellow

Name = ActiveSheet.Shapes(Application.Caller).Name

Can somebody pls look into this as to what is going wrong here

VBA Code:
Private Sub ApplyFormulaToPendingTargets()

Dim shp As shape

Dim color1 As Long, color2 As Long
color1 = RGB(255, 255, 255)
color2 = RGB(166, 166, 166)

Dim ws As Worksheet
' Assign the sheet to a variable
Set ws = Sheets("PENDING TARGETS")
    
Name = ActiveSheet.Shapes(Application.Caller).Name
Range("A1").Value = Name

ws.Range("B5:B1000").ClearContents
        
' Apply formulas
ws.Range("B5:B100").Formula = "=IFERROR(AGGREGATE(15,6,orders_ref/(((orders_design_receipt<>"""")*(" & Range("A1").Value & "=""""))*ISNA(MATCH(orders_ref,B4:B$4,0))),1),"""")"
                 
 For Each shp In ws.Shapes("pending_targets_category").GroupItems
        shp.TextFrame.Characters.Font.Color = color2
        shp.TextFrame.Characters.Font.Bold = False
    Next shp

ws.Shapes(Application.Caller).TextFrame.Characters.Font.Color = color1
ws.Shapes(Application.Caller).TextFrame.Characters.Font.Bold = True

ActiveSheet.Shapes(Application.Caller & "_count").TextFrame.Characters.Font.Color = color1
ActiveSheet.Shapes(Application.Caller & "_count").TextFrame.Characters.Font.Bold = True
End Sub

Regards,

Humayun
 

Excel Facts

What is the fastest way to copy a formula?
If A2:A50000 contain data. Enter a formula in B2. Select B2. Double-click the Fill Handle and Excel will shoot the formula down to B50000.
When you click on a shape, the macro runs and the Application.Caller command returns the name of the Object Shape that the macro was called from. It then uses that name in the code to reference the specific object that called the macro.

If you run the macro directly, there is no object that called the macro. Application.Caller does not know what shape you want and then errors.
 
Upvote 0
When you click on a shape, the macro runs and the Application.Caller command returns the name of the Object Shape that the macro was called from. It then uses that name in the code to reference the specific object that called the macro.

If you run the macro directly, there is no object that called the macro. Application.Caller does not know what shape you want and then errors.
Thanks for the reply

Do we have a workaround for this ??
can you pls come up with some idea - how to make it happen

One thing I am thinking about is to programmatically click a shape by a vba code (if possible)
 
Upvote 0
If you can programmatically click a shape then you must know the shape name or number.
Change the line in Blue to put in the default shape name you want to use if no shape is triggering the code.
Note: the shape name with the suffix "_count" will also need to exist.

Rich (BB code):
Private Sub ApplyFormulaToPendingTargets()

Dim shp As Shape

Dim color1 As Long, color2 As Long

Dim Name As String

color1 = RGB(255, 255, 255)
color2 = RGB(166, 166, 166)

Dim ws As Worksheet
' Assign the sheet to a variable
Set ws = Sheets("PENDING TARGETS")
    
On Error Resume Next
If Not IsError(Application.Caller) Then
    Name = ActiveSheet.Shapes(Application.Caller).Name
Else
    Name = "Oval 1"
End If
Range("A1").Value = Name

ws.Range("B5:B1000").ClearContents
        
' Apply formulas
ws.Range("B5:B100").Formula = "=IFERROR(AGGREGATE(15,6,orders_ref/(((orders_design_receipt<>"""")*(" & Range("A1").Value & "=""""))*ISNA(MATCH(orders_ref,B4:B$4,0))),1),"""")"
                 
 For Each shp In ws.Shapes("pending_targets_category").GroupItems
        shp.TextFrame.Characters.Font.Color = color2
        shp.TextFrame.Characters.Font.Bold = False
    Next shp

ws.Shapes(Name).TextFrame.Characters.Font.Color = color1
ws.Shapes(Name).TextFrame.Characters.Font.Bold = True

ActiveSheet.Shapes(Name & "_count").TextFrame.Characters.Font.Color = color1
ActiveSheet.Shapes(Name & "_count").TextFrame.Characters.Font.Bold = True
End Sub
 
Upvote 0
Do we have a workaround for this ??

The code can be modified to determine the difference between clicked or manually run. Just explain what you intend to happen when manually run the code; process all shapes, or do you have one specific shape to process? If it is a specific shape, what is the name of that shape?
 
Upvote 0
The code can be modified to determine the difference between clicked or manually run. Just explain what you intend to happen when manually run the code; process all shapes, or do you have one specific shape to process? If it is a specific shape, what is the name of that shape?
Hi Alex,
Sorry for coming back late on this & thanks for your reply

I just tried the solution you provided & it runs directly from the VBA window when I press F5 but the below part of the code in bold does not work.

For Each shp In ws.Shapes("pending_targets_category").GroupItems
shp.TextFrame.Characters.Font.Color = color2
shp.TextFrame.Characters.Font.Bold = False
Next shp

ws.Shapes(Application.Caller).TextFrame.Characters.Font.Color = color1
ws.Shapes(Application.Caller).TextFrame.Characters.Font.Bold = True

ActiveSheet.Shapes(Application.Caller & "_count").TextFrame.Characters.Font.Color = color1
ActiveSheet.Shapes(Application.Caller & "_count").TextFrame.Characters.Font.Bold = True




Further, when I try to run the code with the worksheet activate even then the range A1 value is set to blank

Here is the full code

VBA Code:
Private Sub ApplyFormulaToPendingTargets()

Application.ScreenUpdating = False

Dim shp As shape

Dim color1 As Long, color2 As Long
color1 = RGB(255, 255, 255)
color2 = RGB(166, 166, 166)

Dim ws As Worksheet
' Assign the sheet to a variable
Set ws = Sheets("PENDING TARGETS")
    
ws.Unprotect Password:="merchant"

On Error Resume Next
If Not IsError(Application.Caller) Then
    Name = ActiveSheet.Shapes(Application.Caller).Name
Else
    Name = "photo_sample_actual_date"
End If
Range("A1").Value = Name
ws.Range("B5:B1000").ClearContents
        
' Apply formulas
ws.Range("B5:B100").Formula = "=IFERROR(AGGREGATE(15,6,orders_ref/(((" & Range("A1").Value & "=""""))*ISNA(MATCH(orders_ref,B4:B$4,0))),1),"""")"
                                  
 For Each shp In ws.Shapes("pending_targets_category").GroupItems
        shp.TextFrame.Characters.Font.Color = color2
        shp.TextFrame.Characters.Font.Bold = False
    Next shp

ws.Shapes(Application.Caller).TextFrame.Characters.Font.Color = color1
ws.Shapes(Application.Caller).TextFrame.Characters.Font.Bold = True

ActiveSheet.Shapes(Application.Caller & "_count").TextFrame.Characters.Font.Color = color1
ActiveSheet.Shapes(Application.Caller & "_count").TextFrame.Characters.Font.Bold = True

Range("A:H").Select 'set range zoom
ActiveWindow.Zoom = True
Range("B4").Select
ActiveWindow.ScrollRow = 1
ActiveWindow.ScrollColumn = 1
                 
' Protect the sheet
ws.Protect Password:="merchant"
Application.ScreenUpdating = False

End Sub
 
Upvote 0
The code can be modified to determine the difference between clicked or manually run. Just explain what you intend to happen when manually run the code; process all shapes, or do you have one specific shape to process? If it is a specific shape, what is the name of that shape?
Hi Alpha,

I want the code to process a specific shape with the name "photo_sample_actual_date"
 
Upvote 0
I think @AlphaFrog is better placed to trouble shoot this than I am.
You didn't indicate whether and what error message you got when you said it didn't run the loop.
Add the line in blue to turn the error message back on.
Does the Group "pending_targets_category" exist ?
Rich (BB code):
On Error Resume Next
If Not IsError(Application.Caller) Then
    Name = ActiveSheet.Shapes(Application.Caller).Name
Else
    Name = "photo_sample_actual_date"
End If
On Error GoTo 0
Range("A1").Value = Name
 
Upvote 0
I think @AlphaFrog is better placed to trouble shoot this than I am.
You didn't indicate whether and what error message you got when you said it didn't run the loop.
Add the line in blue to turn the error message back on.
Does the Group "pending_targets_category" exist ?
Rich (BB code):
On Error Resume Next
If Not IsError(Application.Caller) Then
    Name = ActiveSheet.Shapes(Application.Caller).Name
Else
    Name = "photo_sample_actual_date"
End If
On Error GoTo 0
Range("A1").Value = Name
When I runt he code without the On Error GoTo 0 then the code works but below part of the code which is responsible for changing the fonts does not work. I don' get any error message

VBA Code:
For Each shp In ws.Shapes("pending_targets_category").GroupItems
shp.TextFrame.Characters.Font.Color = color2
shp.TextFrame.Characters.Font.Bold = False
Next shp

ws.Shapes(Application.Caller).TextFrame.Characters.Font.Color = color1
ws.Shapes(Application.Caller).TextFrame.Characters.Font.Bold = True

ActiveSheet.Shapes(Application.Caller & "_count").TextFrame.Characters.Font.Color = color1
ActiveSheet.Shapes(Application.Caller & "_count").TextFrame.Characters.Font.Bold = True



But When I run with the On Error GoTo 0 It says that the item with the specified name was not found with below part highlighted in yellow

VBA Code:
ws.Shapes(Application.Caller).TextFrame.Characters.Font.Color = color1
 
Upvote 0
I used Name in the code I gave you, so that it uses the default shape name if no shape is selected

Rich (BB code):
ws.Shapes(Name,).TextFrame.Characters.Font.Color = color1
ws.Shapes(Name,).TextFrame.Characters.Font.Bold = True

ActiveSheet.Shapes(Name, & "_count").TextFrame.Characters.Font.Color = color1
ActiveSheet.Shapes(Name, & "_count").TextFrame.Characters.Font.Bold = True
 
Upvote 0

Forum statistics

Threads
1,225,625
Messages
6,186,071
Members
453,336
Latest member
Excelnoob223

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