Originally Posted by
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
Reply With Quote
