Code Continually runs

[andrewb90]

Hello all,


I have a macro that does what needs to be done, then while it appears to not be doing anything in excel, VBA shows it continually running, and I'm not sure what I've done to cause that. Any help would be greatly appreciated.

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

 

[StephenCrump]

Repost: https://www.mrexcel.com/forum/excel-questions/1025992-error-end-loop.html#post4926448