Error at end of loop

[andrewb90]

I have this code that deletes objects all with the same name, but once it gets to the end I get an error. Is there a way to either:
A - stop the error from popping up at the end of the code. or
B - Just have the code fade and delete all the objects at the same time

Do While ActiveSheet.Shapes("lologo1").Visible = True

    With ActiveSheet.Shapes("lologo1")
        rep_countB = 0
        Do
        DoEvents
        ActiveSheet.Shapes.Range(Array("lologo1")).Select
        Selection.ShapeRange.SoftEdge.Radius = Selection.ShapeRange.SoftEdge.Radius + 3
            rep_countB = rep_countB + 1
            timeoutq (0.01)
    Loop Until rep_countB = 6
        ActiveSheet.Shapes.Range(Array("lologo1")).Delete


    End With
    
Loop

 

[mole999]

maybe a simple On Error Resume Next

 

[andrewb90]

I tried that. That line resulted in an error as well.

 

[mole999]

forgive me on this, that line should not cause any error, where in the code is that applied ?

 

[andrewb90]

Know that you mention it, that’s likely my issue. For whatever reason I put that directly above the code instead of at the beginning of the sub. I’ll make that correction when I get back to my computer. Hopefully that does it. Perhaps some sleep first, as I’m clearly not thinking too well....

 

[andrewb90]

I tried that, and while it does seem to prevent errors. My code continually runs. Here's what my entire code looks like at this point.

Sub mchoice2()On Error Resume Next
Dim R As Long, C As Long, VR As Range, Cell As Range
Set VR = ActiveWindow.VisibleRange
sStartSheet = ActiveSheet.Name
    Sheets("logos").Select
    ActiveSheet.Shapes.Range(Array("lologo1")).Select
    Selection.copy
    Worksheets(sStartSheet).Select
    rep_count = 0
    Do
    DoEvents
    'MsgBox "HI"
        Do
            R = Application.RandBetween(1, VR.Rows.Count - 1)
            C = Application.RandBetween(1, VR.Columns.Count - 1)
            Set Cell = VR.Cells(R, C)
        Loop Until Cell.EntireColumn.Hidden = False And Cell.EntireRow.Hidden = False
        Cell.Select
        
        ActiveSheet.Paste
        rep_count = rep_count + 1
        timeoutq (0.2)
Loop Until rep_count = 6
MsgBox "start"
timeoutq (2.01)
MsgBox "end"
'comment out below


Do While ActiveSheet.Shapes("lologo1").Visible = True
'this is doing everything right except for the error at the end
    With ActiveSheet.Shapes("lologo1")
        rep_countB = 0
        Do
        DoEvents
        ActiveSheet.Shapes.Range(Array("lologo1")).Select
        Selection.ShapeRange.SoftEdge.Radius = Selection.ShapeRange.SoftEdge.Radius + 3
            rep_countB = rep_countB + 1
            timeoutq (0.01)
    Loop Until rep_countB = 6
        ActiveSheet.Shapes.Range(Array("lologo1")).Delete


    End With
    
Loop






End Sub

I need someway to exit the loop now, but I'm not sure how to go about that properly.

 

[andrewb90]

bump

 

[StephenCrump]

Coming back to your original post, the problem is with this loop, which is redundant:

Do While ActiveSheet.Shapes("lologo1").Visible = True
    '....
Loop

You can make the shape fade away, but this doesn't affect the .Visible property. And after you .Delete the Shape, this loop will error!

I haven't played with .SoftEdge.Radius before, but it looks like it can accommodate values in the range 0 to 99.

In which case perhaps:

Const INC = 3

With ActiveSheet.Shapes("lologo1")
    For i = .SoftEdge.Radius To 99 Step INC
        .SoftEdge.Radius = i
        timeoutq (0.01)
    Next i
    .Delete
End With

 

[andrewb90]

I tried that, the result is if I don't have the

Do While ActiveSheet.Shapes("lologo1").Visible = True

loop, it will only affect 1 object instead of all copies, and If I put that inside the loop, it's identical to before where the code doesn't end.

 

[andrewb90]

I think I've solved it. by adding an additional count each time an item was deleted I could loop until that count was reached. My only problem, is that this relies on my knowing exactly how many copies of my object are visible and needing to be deleted. If anybody has a revision that would allow for any variable of deleted shapes instead of a fixed number, that would be greatly appreciated!

rep_countDel = 0
Do Until rep_countDel = 15


    With ActiveSheet.Shapes("lologo1")
        rep_countB = 0
        Do
        DoEvents
        ActiveSheet.Shapes.Range(Array("lologo1")).Select
        Selection.ShapeRange.SoftEdge.Radius = Selection.ShapeRange.SoftEdge.Radius + 3
            
            rep_countB = rep_countB + 1
            timeoutq (0.01)
        Loop Until rep_countB = 5 'this counter increases every fade  not delete
        ActiveSheet.Shapes.Range(Array("lologo1")).Delete
        rep_countDel = rep_countDel + 1
        
    End With


Loop