Need to Stop DoEvents Automatically

[ranjith2523]

Hi Friends,

I wrote the simple code below to create a small animation (rotate a shape) and the shape is beautifully turning as expected.
But my concern is, I need the automation to automatically STOP after 10 seconds. Or at least it should stop after I click on a message box or something like that.
I tried my best and searched many things on Google but nothing worked out for me
I appreciate your help and support here.

Do
DoEvents
x = x - 5
ThisWorkbook.Sheets("Execute").Shapes.Range(Array("Freeform 4")).Rotation = x
ThisWorkbook.Sheets("Execute").Shapes.Range(Array("Freeform 5")).Rotation = x
ThisWorkbook.Sheets("Execute").Shapes.Range(Array("Freeform 6")).Rotation = x
Loop Until x = 217


Regards,
Ranjith

 

[ranjith2523]

Found the solution Thanks for all who viewed my thread

 

[Peter_SSs]

Found the solution

Good to hear that.
If you would like to post the solution then it is perfectly fine to mark your post as the solution to help future readers. Otherwise, please do not mark a post that doesn't contain a solution.

 

[ranjith2523]

Found the solution Thanks for all who viewed my thread

Solution:

I just added a loop code to insert numbers from 1 to 500 and when it reaches 350 will get a message stating "Data Cleared" Also the DOEVENT loop will stop

In this way, i stopped the DoEvent

Dim K As Long
K = 1

Do Until K = 500

DoEvents

x = x - 5

'ThisWorkbook.Sheets("Execute").Shapes.Range(Array("Freeform 6")).Top = x
ThisWorkbook.Sheets("Execute").Shapes.Range(Array("Freeform 4")).Rotation = x
ThisWorkbook.Sheets("Execute").Shapes.Range(Array("Freeform 5")).Rotation = x
ThisWorkbook.Sheets("Execute").Shapes.Range(Array("Freeform 6")).Rotation = x

If K < 350 Then
Cells(K, 1).Value = K
Else
MsgBox "Data Cleared"
Exit Do

End If
K = K + 1
Loop

 

[ranjith2523]

Good to hear that.
If you would like to post the solution then it is perfectly fine to mark your post as the solution to help future readers. Otherwise, please do not mark a post that doesn't contain a solution.

Yes you are correct and sorry for that.. posted the solution now.