VBA Code Problem

[hrayani]

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

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

 

[hrayani]

I used Name in the code I gave you, so that it uses the default shape name if no shape is selected

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

So, I need to amend the code & change all the application caller to Name to get it to work .... Did I get it right ??

 

[Alex Blakenburg]

All except the first one which is where it captures it using Name and is inside the If statement and should that error out because none are selected it uses the default name in the Else part of the If statement.

 

[hrayani]

All except the first one which is where it captures it using Name and is inside the If statement and should that error out because none are selected it uses the default name in the Else part of the If statement.

Thanks - the below entire code is running now directly from the VBA window with F5

But, the only problem remain is it does not work with the worksheet activate event - I don't know why
Range A1 is just set to blank when I try to run it with worksheet activate event

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(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

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

 

[Alex Blakenburg]

Is the activate event in the sheet "PENDING TARGETS" ?

 

[hrayani]

Is the activate event in the sheet "PENDING TARGETS" ?

Yes

 

[Alex Blakenburg]

Assuming the sub is in a different module in the activate module try calling it like this (replace the Module_Name with the actual module name

Application.Run Module_Name.ApplyFormulaToPendingTargets

 

[Alex Blakenburg]

Oops correction it needs quotes:

Application.Run "Module_Name.ApplyFormulaToPendingTargets"

 

[hrayani]

Oops correction it needs quotes:

Application.Run "Module_Name.ApplyFormulaToPendingTargets"

No Friend - it is not working
I just can't understand why cell A1 is set to blank. I don't see anything in the code that is causing this to happen. or maybe I am overlooking anything ?? not sure...


If possible, can't we just pragmatically click a shape ? this will serve the purpose

But again, I am wondering that the code is working from the VBA window but why isn't the below working ??

Private Sub Worksheet_Activate()
Worksheets("PENDING TARGETS").EnableCalculation = True
Application.Run "Pending_targets.ApplyFormulaToPendingTargets"
End Sub

 

[MARK858]

I just can't understand why cell A1 is set to blank. I don't see anything in the code that is causing this to happen. or maybe I am overlooking anything ?? not sure...

Runs fine for me with the correct module name (in my case Module2) i.e. it puts photo_sample_actual_date in A1 when the worksheet activates

What happens when you remove the On Error Resume Next (what error is it designed to pick up on anyway? you should also set it to 0 immediately after the error you expect has passed)?

Btw why is the Application.ScreenUpdating at the end of your code set to False and not True (not that it makes any difference as it will be True anyway when the sub ends)?

' Protect the sheet
ws.Protect Password:="merchant"
Application.ScreenUpdating = False

 

[hrayani]

What happens when you remove the On Error Resume Next (what error is it designed to pick up on anyway? you should also set it to 0 immediately after the error you expect has passed)?

When I run it without On Error Resume Next then it says "The item with the specified name wasn't found" with below part of the code highlighted in yellow
Name = ActiveSheet.Shapes(Application.Caller).Name

When I run it with On Error Resume Next then the cell A1 is set to blank

In both the cases i.e. with & without On Error Resume Next - I am able to run the code successfully within the VBA window
The problem is with the worksheet activate event

Btw why is the Application.ScreenUpdating at the end of your code set to False and not True (not that it makes any difference as it will be True anyway when the sub ends)?

I often see the screen flickering when screen updating is set to True at the end of the sub - this is why I always keep it to false