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

davio565

New Member
Joined
Jan 19, 2017
Messages
23
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
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.
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:
Code:
Private Sub Workbook_Open()
  StartLogging
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  StopLogging
End Sub

Normal code module:
Code:
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
 
Last edited:
Upvote 0
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:
Code:
Private Sub Workbook_Open()
  StartLogging
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  StopLogging
End Sub

Normal code module:
Code:
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!
 
Upvote 0
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.
 
Upvote 0

Forum statistics

Threads
1,213,550
Messages
6,114,265
Members
448,558
Latest member
aivin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top