Do Until Loop for time

[shumba]

Good Morning,


I would like to loop the procedure below for one minute. I have used a Do Until Loop but this is not working.

Please will someone show me where I am going wrong.

Public Const cRunForTime = "00:01:00"
  

Sub Phase1()
     Sheets("Data Collection and Compilation").Select 
      Do Until TimeValue(cRunForTime)
      Selection.Offset(-1, 0).Value = Now
      Selection.NumberFormat = "0.00%"
      Range("h2:h100").Copy
      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
          :=False, Transpose:=False
      Selection.Offset(0, 1).Select
      Loop
  End Sub

Thanks.

Rob.

 

[repairman615]

Hello, I cannot say this works but I am thinking setting the time to stop, then checking if now equals that time:

<font face=Courier New><SPAN style="color:#00007F">Public</SPAN> <SPAN style="color:#00007F">Const</SPAN> cRunForTime = Now + "00:01:00"<br>  <br><br><SPAN style="color:#00007F">Sub</SPAN> Phase1()<br>     Sheets("Data Collection and Compilation").Select<br>      <SPAN style="color:#00007F">Do</SPAN> <SPAN style="color:#00007F">Until</SPAN> TimeValue(cRunForTime) = Now<br>      Selection.Offset(-1, 0).Value = Now<br>      Selection.NumberFormat = "0.00%"<br>      Range("h2:h100").Copy<br>      Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _<br>          :=False, Transpose:=False<br>      Selection.Offset(0, 1).Select<br>      <SPAN style="color:#00007F">Loop</SPAN><br>  <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[shumba]

Thanks for your help.

Regards,

Rob.