Use Event Procedure and OnTime to Stop a Macro

hi,

I'm pleased I could help :-)


Your code can be shortened slightly by removing or merging the ".select" & the "selection." sections. I haven't entered any code for the counter because I'm not too sure where it needs to go.

[QUOTE

Private Sub CommandButton1_Click()

    TimerSeconds = 15                   
    TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
    
    Range("G6").ClearContents
'rename the sheet on the rh side of the equals sign as needed
    Sheets("Source").Range("F6").value = sheets("?").Range("F10").value
    Range("C2").Select
   
End Sub

Private Sub CommandButton2_Click()
    On Error Resume Next
    KillTimer 0&, TimerID
    
    Range("F6").ClearContents
    Range("G6").value = Range("F10").value
    Range("C2").Select
End Sub

[/QUOTE]

Also, on the off-chance that you may change to Excel 2007 in the foreseeable future I would change:

.Sheets("Value1").Range("A65536").End(xlUp)(2, 1)

to

.Sheets("Value1").cells(rows.count,1).End(xlUp)(2, 1)

because this allows for the fact that there are more than 65K rows in Excel 2007.


Now, my turn for a question
Where did you learn the syntax for the brackets at the end of the range address?
I don't think I've ever seen it before but it looks interesting & I'd like to learn more about it.

Let us know if you need any more clarification around the use of a counter...

hth
Rob

hi

Asking questions is good & I'd say Andy could be much more help than I - esp considering I don't understand the TimerProc well enough to get it to work when testing at home.
The section between the asterisks shows the principle (check the startcell, id an endcell & run until then) I'd use to stop the macro when enough cells are filled, but I don't know how you are looping at the moment...

Also, I have returned the error to zero in the second commandbutton.

Option Explicit
Public Declare Function SetTimer Lib "user32" ( _
    ByVal HWnd As Long, ByVal nIDEvent As Long, _
    ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long
Public Declare Function KillTimer Lib "user32" ( _
    ByVal HWnd As Long, ByVal nIDEvent As Long) As Long
Public TimerID As Long
Public TimerSeconds As Single

Sub TimerProc(ByVal HWnd As Long, ByVal uMsg As Long, _
    ByVal nIDEvent As Long, ByVal dwTimer As Long)
    
With ThisWorkbook
    .Sheets("Value1").Cells(Rows.Count, 1).End(xlUp)(2, 1) = .Sheets("Source").Range("B3")
    .Sheets("Value1").Cells(Rows.Count, 1).End(xlUp)(1, 3) = .Sheets("Source").Range("B4")
    .Sheets("Value1").Cells(Rows.Count, 1).End(xlUp)(1, 5) = .Sheets("Source").Range("B5")
    .Sheets("Value1").Cells(Rows.Count, 1).End(xlUp)(1, 8) = .Sheets("Source").Range("C2")
    .Sheets("Value1").Cells(Rows.Count, 1).End(xlUp)(1, 10) = .Sheets("Source").Range("B7")
End With
End Sub

Private Sub CommandButton1_Click()
'**************************************************
Const RepeatsPlusOne As Long = (4 * 60 * 4) + 1
'=4 hrs * 60 min * 4 times per min + 1 to make sure the last log is made
Dim StartCell As Range
Dim EndCell As Range

Set StartCell = ThisWorkbook.Sheets("Value1").Cells(Rows.Count, 1).End(xlUp)(2, 1)
Set EndCell = StartCell.Offset(RepeatsPlusOne, 0)
If ThisWorkbook.Sheets("Value1").Cells(Rows.Count, 1).End(xlUp)(2, 1).Address = EndCell.Address Then Exit Sub

' or maybe uncomment the ###
'### Do Until ThisWorkbook.Sheets("Value1").Cells(Rows.Count, 1).End(xlUp)(2, 1).Address = EndCell.Address
'**************************************************

TimerSeconds = 15
    TimerID = SetTimer(0&, 0&, TimerSeconds * 1000&, AddressOf TimerProc)
    
    Range("G6").ClearContents
'rename the sheet on the rh side of the equals sign as needed
    Sheets("Source").Range("F6").Value = Sheets("value1").Range("F10").Value
    Range("C2").Select
'### loop

End Sub

Private Sub CommandButton2_Click()
    On Error Resume Next
        KillTimer 0&, TimerID
    On Error GoTo 0 ' added to ensure the error action is reset
    Range("F6").ClearContents
    Range("G6").Value = Range("F10").Value
    Range("C2").Select
End Sub

hth
Rob