Copy and Paste Values at 1 min intervals

[GTO]

Hi again,

If I am understanding what we want, to recap:

You have data being updated in row 2. Once a minute, you would like the latest data to be "copied" down to the first available/empty row below the "live" data. In looking, it appeared to me that you wanted a timehack, and I think maybe this would go with the corresponding record.

I tacked in a toggle, so we could shut off, or restart, the auto record creations...

If the above is close, does this help?

In the ThisWorkbook Module:
[VBA]Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Shutdown
Application.OnKey "^d"
End Sub

Private Sub Workbook_Open()
Startup
Application.OnKey "^d", "ToggleUpdating"
End Sub
[/VBA]

In a Standard Module:
[VBA]
Option Explicit

Private lRightColumn As Long
Private rngLiveValues As Range
Private dtmScheduledTime As Date
Private bolUpdating As Boolean

Const INTERVAL As Double = 1.15740740740741E-04 '<--- 10 seconds, change to suit.

Sub Startup()
Dim wksGrains1MinData As Worksheet

'// Set a reference to the worksheet we are running against. Personally, I would //
'// just change the sheet's CodeName to something intuitive and use that. //
Set wksGrains1MinData = Sheet1
With wksGrains1MinData
'// No safety included for the case of no data in row 1. As long as that is no //
'// issue, it appeared to me that we could count on row 1 to define the last //
'// currently used column. //
lRightColumn = RangeFound(.Rows(1), , .Cells(1)).Column
'// Set a reference to our non-changing range that we wish to rip the live //
'// values from; hence the module level variable. //
Set rngLiveValues = .Range(.Cells(2, "B"), .Cells(2, lRightColumn))
End With

bolUpdating = True
Call Main
End Sub

Sub Shutdown()
KillTimer
bolUpdating = False
End Sub

Sub ToggleUpdating()
'// Using a module level flag, toggle updating with our shortcut key combo //
If Not bolUpdating Then
Startup
Else
Shutdown
End If
End Sub

Sub Main()
Dim rngSearchRange As Range
Dim lOpenRow As Long

With Sheet1
'// Find a cell in the last row with data in it. If there is no initial "live" //
'// data, bailout. //
Set rngSearchRange = RangeFound(rngLiveValues.Resize(.Rows.Count - 1))
If rngSearchRange Is Nothing Then
MsgBox "ACK!"
KillTimer
Exit Sub
End If

'***just for demo, to provide "live" data*****************
Randomize '*
'Int((upperbound - lowerbound + 1) * Rnd + lowerbound) '*
rngLiveValues.Value = Int((1000 - 10 + 1) * Rnd + 10) '*
'*********************************************************

lOpenRow = rngSearchRange.Row + 1
'// Update first open row with data and enter time in column 1 //
.Range(.Cells(lOpenRow, 2), .Cells(lOpenRow, lRightColumn)).Value = rngLiveValues.Value
.Cells(lOpenRow, 1).Value = Time

dtmScheduledTime = Now() + CDate(INTERVAL)
ResetTimer dtmScheduledTime
End With
End Sub

Sub ResetTimer(NextTime As Date)
Application.OnTime NextTime, "Main"
End Sub

Sub KillTimer()
On Error Resume Next
Application.OnTime dtmScheduledTime, "Main", , False
On Error GoTo 0
End Sub

Function RangeFound(SearchRange As Range, _
Optional ByVal FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function[/VBA]

See attached wb.

Hope that helps,

Mark