Dynamic cells - Copy column every n minutes into sheet 2 and timestamp

[davio565]

Hi guys,

Ok I have come close with this but my code is heavy and messy so turning to the experts...:

So I have a column (let's say C) which has dynamic data (Like stock data) which is updating every second.

I'd like to copy column C from row 5 to 1000 (C5:C1000) every 'n' minutes (let's say every 5 minutes) and paste the column into sheet two. Sheet two the first column would start from D5 and every five minutes when the dynamic data is copied I want it to be pasted in the next empty column along so as to not overwrite the previous copy and paste.

If possible, Id like the sheet 2 pastes to have a timestamp of the copy/paste (maybe in the top row or something) so I can track the ups and downs of the values over time more accurately.

Sheet speed is king here so a messier code which minimises sheet slowness would be preferential to a neat code which needs more processing power.

Any help much appreciated as my VBA is very basic at best.

Many thanks
Dave

 

[ParamRay]

1) Paste the first code into the ThisWorbook module;
2) Paste the second code into a normal code module;
3) Save the workbook and close it; and
4) Re-open the workbook to start the logging process.

Notes:
a) I've added some comments in places you'll need to make some minor adjustments to the code.
b) In my tests, the macro took milliseconds to run, and you won't even notice anything happening.

ThisWorkbook module:

Private Sub Workbook_Open()
  StartLogging
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  StopLogging
End Sub

Normal code module:

Sub StartLogging()
  Const strSOURCE_SHEET = "Stock Data" ' <-- name of sheet containing stock data
  Const strTARGET_SHEET = "Data Log" ' <-- name of sheet to periodically log data to
  Const strSOURCE_RANGE = "C5:C1000" ' <-- cell address of data to be logged
  Dim intNextCol As Integer
  Dim rngSource As Range
  
  On Error GoTo ErrorHandler
  Application.ScreenUpdating = False
  Set rngSource = ThisWorkbook.Sheets(strSOURCE_SHEET).Range(strSOURCE_RANGE).Columns(1)
  With ThisWorkbook.Sheets(strTARGET_SHEET)
    intNextCol = .Cells(5, .Columns.Count).End(xlToLeft).Column + 1
    .Cells(5, intNextCol).Value = Now()
    .Cells(5, intNextCol).Font.Bold = True
    .Cells(6, intNextCol).Resize(rngSource.Cells.Count).Value = rngSource.Value
    .Columns(intNextCol).AutoFit
  End With
  m_dtmNextSchedule = Now() + TimeValue("0:05") ' <-- reschedule for 5 minutes time
  Application.OnTime m_dtmNextSchedule, "StartLogging", Schedule:=True
  
ExitHandler:
  On Error Resume Next
  Application.ScreenUpdating = True
  Exit Sub
ErrorHandler:
  MsgBox Err.Description, vbExclamation
  Resume ExitHandler
End Sub

Sub StopLogging()
  On Error GoTo ErrorHandler
  Application.OnTime m_dtmNextSchedule, "StartLogging", Schedule:=False
  Exit Sub
ErrorHandler:
  MsgBox Err.Description, vbExclamation
End Sub

 

[davio565]

1) Paste the first code into the ThisWorbook module;
2) Paste the second code into a normal code module;
3) Save the workbook and close it; and
4) Re-open the workbook to start the logging process.

Notes:
a) I've added some comments in places you'll need to make some minor adjustments to the code.
b) In my tests, the macro took milliseconds to run, and you won't even notice anything happening.

ThisWorkbook module:

Private Sub Workbook_Open()
  StartLogging
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  StopLogging
End Sub

Normal code module:

Sub StartLogging()
  Const strSOURCE_SHEET = "Stock Data" ' <-- name of sheet containing stock data
  Const strTARGET_SHEET = "Data Log" ' <-- name of sheet to periodically log data to
  Const strSOURCE_RANGE = "C5:C1000" ' <-- cell address of data to be logged
  Dim intNextCol As Integer
  Dim rngSource As Range
  
  On Error GoTo ErrorHandler
  Application.ScreenUpdating = False
  Set rngSource = ThisWorkbook.Sheets(strSOURCE_SHEET).Range(strSOURCE_RANGE).Columns(1)
  With ThisWorkbook.Sheets(strTARGET_SHEET)
    intNextCol = .Cells(5, .Columns.Count).End(xlToLeft).Column + 1
    .Cells(5, intNextCol).Value = Now()
    .Cells(5, intNextCol).Font.Bold = True
    .Cells(6, intNextCol).Resize(rngSource.Cells.Count).Value = rngSource.Value
    .Columns(intNextCol).AutoFit
  End With
  m_dtmNextSchedule = Now() + TimeValue("0:05") ' <-- reschedule for 5 minutes time
  Application.OnTime m_dtmNextSchedule, "StartLogging", Schedule:=True
  
ExitHandler:
  On Error Resume Next
  Application.ScreenUpdating = True
  Exit Sub
ErrorHandler:
  MsgBox Err.Description, vbExclamation
  Resume ExitHandler
End Sub

Sub StopLogging()
  On Error GoTo ErrorHandler
  Application.OnTime m_dtmNextSchedule, "StartLogging", Schedule:=False
  Exit Sub
ErrorHandler:
  MsgBox Err.Description, vbExclamation
End Sub

Hi ParamRay,

This code is perfect thank-you! Really appreciate the clarity of this one it's perfect for tweaking too with my limited knowledge. Great for helping me improve my VBA too.

Love this.

Thanks again!

 

[ParamRay]

Hi ParamRay,

This code is perfect thank-you! Really appreciate the clarity of this one it's perfect for tweaking too with my limited knowledge. Great for helping me improve my VBA too.

Love this.

Thanks again!

You're welcome.