Record Data Every Second Help

Not sure if this is what you're trying to achieve? Please try the below code.

Option Explicit
Dim TimeToRun

Sub auto_open()
Call ScheduleCopyPriceOver
End Sub

Sub ScheduleCopyPriceOver()
TimeToRun = Now + TimeValue("00:00:01")
Application.OnTime TimeToRun, "CopyPriceOver"
End Sub
Sub CopyPriceOver()
Calculate
Sheets("Data").Range("C3:C209").Copy
Sheets("Data").Range("IV3:IV209").End(xlToLeft).Offset(0, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Call ScheduleCopyPriceOver
End Sub

Sub auto_close()
On Error Resume Next
Application.OnTime TimeToRun, "CopyPriceOver", , False
End Sub

Thanks for your help Jayesh25

It is what I am trying to achieve but problem with copy and paste is that I cannot continue to work/navigate the spreadsheet whilst the macro is running, hence the reason why I used the .value instead but I cant get it to work

Any other suggestions?

Thanks

Fu On

Apologies HaHoBe

It was my first post, still learning. I have edited the original post to comply with the rules

So do any have any suggestions on how I can solve this code?

Thanks

Fu On

Hi fuonli,

This should fullfill your requirements i hope. Please change the (counter,10) number to whatever column you'd like to record your back up data to.. Currently it's set to column 10 which will be column J

Option Explicit
Dim TimeToRun

Sub auto_open()
Call ScheduleCopyPriceOver
End Sub

Sub ScheduleCopyPriceOver()
TimeToRun = Now + TimeValue("00:00:01")
Application.OnTime TimeToRun, "CopyPriceOver"
End Sub
Sub CopyPriceOver()
Dim counter As Integer, MYWB As Object, lr As Range
Set MYWB = ThisWorkbook.Sheets("data").Cells
Set lr = MYWB(Rows.Count, 10).End(xlUp).Offset(1, 0)
counter = 1
Calculate
'clear previous record of data
For counter = 1 To lr.Row - 1
MYWB(counter, 10).Value = ""
Next counter
'copy and paste new data
counter = 1
Set lr = MYWB(Rows.Count, 3).End(xlUp).Offset(1, 0)
Do While counter < lr.Row
MYWB(counter, 10).Value = MYWB(counter, 3).Value
counter = counter + 1
Loop
Call ScheduleCopyPriceOver
End Sub

Sub auto_close()
On Error Resume Next
Application.OnTime TimeToRun, "CopyPriceOver", , False
End Sub