Macro gives an error: Run-time error 1004. Method Run of object Application failed.

[ttt480]

Hello friends.

Macro gives an error:
Run-time error 1004. Method Run of object _Application failed.

How to fix this error ?

Sub Macro1()
Dim arr As Collection, x, t, i
Set arr = New Collection
For Each x In Range(Cells(6, 17), Cells(Rows.Count, 17).End(xlUp))
arr.Add x.Value
arr.Add ActiveSheet.Cells(x.Row, 9 + x.Column)
Next x
    'arr = Range(Cells(6, 17), Cells(Rows.Count, 17).End(xlUp)).Value
        For i = 1 To arr.Count
            If Not IsEmpty(arr(i)) Then
                If i / 2 = Int(i / 2) Then Macr = "J" & (5 + i) Else Macr = "S" & (5 + i)
                Application.Run arr.Item(i)
                t = Now + TimeValue("0:00:05")
                    Do
                        DoEvents
                    Loop While t > Now
            End If
        Next i
Set arr = Nothing
End Sub

The error highlights the line :
Application.Run arr.Item(i)

 

[mole999]

stepping through with F8 does it break on the 1st loop or many.
1004 indicates something is missing.
what is the value of arr.Item(i) when you hover over it as you step through

 

[ttt480]

mole999, the entire macro is given in the file.
Why " arr.Item (i) " throws an error ?

https://dropmefiles.com/1MKWK

 

[mole999]

adding
on error resume next
to the beginning of that sub generates the error with

Set shpHost = ActiveSheet.Shapes("Rectangle 5")
Set shp = ActiveSheet.Shapes.AddPicture(Range(Macr), False, True, -1, -1, -1, -1)

 

[ttt480]

mole999, It's not working.

Now the script just ignores the presence of"macro 4".
(The idea is that the script should execute all macros listed in the table.)

Sub Macro4()
    Dim shpHost As Shape, shp As Shape
    Dim var
    
    Application.ScreenUpdating = False
    On Error Resume Next
    ActiveSheet.Shapes("Added").Delete
    On Error GoTo 0
    
   On Error Resume Next
    Set shpHost = ActiveSheet.Shapes("Rectangle 5")
     Set shp = ActiveSheet.Shapes.AddPicture(Range(Macr), False, True, -1, -1, -1, -1)
     shp.Name = "Added"
    shp.LockAspectRatio = True
    If shp.Width > shp.Height Then
        shp.Height = shpHost.Height
        shp.Top = shpHost.Top
        var = shpHost.Left + shpHost.Width / 2
        shp.Left = var - shp.Width / 2
    Else
        shp.Width = shpHost.Width
        shp.Left = shpHost.Left
        var = shpHost.Top + shpHost.Height / 2
        shp.Top = var - shp.Height / 2
    End If
    shp.ZOrder msoSendToBack
    Application.ScreenUpdating = True
End Sub

 

[mole999]

I suggested that should go in the first module. it is already in macro4 anyway

 

[ttt480]

mole999, What should be changed in" macro 4 " for the main script to start working ?

 

[ttt480]

I solved it.
This topic can be closed.

 

[mole999]

what was the cause

 

[ttt480]

An array was formed incorrectly.