Simple Copy and Update Cell Value Every Minute

[user04]

I am trying to grab the value of a cell every time it updates and copy that value and store in a new cell.

So I have a cell (A2) and it updates every 60 seconds, I need that value for t=1 (first time) to be copy and pasted into a new cell (B2). Then when t=2 (second time, 60 seconds later) I need the value to be pasted into the same column but a new row, namely cell C2. Then when t=3 (third time), I need it to be copied to cell D2 and so on.

I'm assuming it just a macro that is called every 60 seconds and grabs the value of A2, but then needs to find the next cell in column B that is empty and paste it there. Is this right?

I've tried to look up for an hour now on how to do something like this but all the VB code I see doesn't really help me out. I'm assuming this should be a relatively simple operation, but just can't seem to find any help on it.

Any help is greatly appreciated!

Thanks!

 

[limbaddinesh]

Hello Sir,

This code is working fine but still there is one problem.

Values transferring to sheet 2 is only up to cell no 64.

Means when the value of C2 is updating,code copy this value to sheet2.Column A only up to 64 cells.

Then after values are not updating in next cells from A65 onwards.

Is it possible to add the timer in this code???

Your help is highly appreciable.

Thanks.

 

[jbeaucaire]

There is nothing in this code that restricts to 64 cells, so that effect is coming from something I can't guess.

This macro is not timer-compatible. You might what to start again in a thread of your own with a more specific description of what you're trying to achieve, this thread may be the wrong starting point.

 

[amitsan]

Hello Sir,

This code is working fine but still there is one problem.

Values transferring to sheet 2 is only up to cell no 64.

Means when the value of C2 is updating,code copy this value to sheet2.Column A only up to 64 cells.

Then after values are not updating in next cells from A65 onwards.

Is it possible to add the timer in this code???

Your help is highly appreciable.

Thanks.

Just change the code like this...

Sheets("Sheet2").Range("A" & Cells(Rows.Count).Row).End(xlUp).Offset(1, 0).Value = Range("C2").Value to

Sheets("Sheet2").Range("A" & Cells(Rows.Count, 1).Row).End(xlUp).Offset(1, 0).Value = Range("C2").Value

try it!!

 

[bpond]

Dear jbeaucaire and everyone,

I am very lucky found the post here this is what I have tried to do for quite sometime. Thank you for the answer.

However, I am still struggling with tweaking the code how to copy data and paste to the next column instead of the row down as the original code. Please anyone, if you were not busy and have spare time. Please kindly lead me to the light. I am looking forward to hearing a news form you guys.

I do appreciate and salute you in advance.

Yours sincerely,
Kittikorn

 

[jbeaucaire]

I am still struggling with tweaking the code how to copy data and paste to the next column instead of the row down as the original code.
Kittikorn

One example:

Sheets("Sheet2").Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = Range("C2").Value

would change to

Sheets("Sheet2").Cells(1, Columns.Count).End(xltoLeft).Offset(0, 1).Value = Range("C2").Value

 

[bpond]

Dear jbeaucaire,


Thank you very much for your quick reply. Your code is perfectly work.
You are absolutely the legend.

Have a lovely day,
Kittikorn

 

[bpond]

Dear jbeaucaire,

I have tried to tweak more about the code to get what exactly I need by combining those two of your codes plus one with copying a formula (adjust from your original code).

Code1:
Option Explicit
Public dTime As Date
Sub ValueStore()
Dim dTime As Date
Sheets("Sheet1").Cells(2, Columns.Count).End(xlToLeft).Offset(0, 1).Value = Range("C2").Value
Sheets("Sheet1").Cells(3, Columns.Count).End(xlToLeft).Offset(0, 1).Value = Range("C3").Value
Sheets("Sheet1").Cells(4, Columns.Count).End(xlToLeft).Offset(0, 1).Formula = Range("C4").Formula
Call StartTimer
End Sub

For the code1, I put it as a module. I run fine with the result. But for the formula part in Cells 4, it copies the formula from “C4” and pastes it to D4, E4 and so on. But the formula will not change to according to the new relate cell. (Umm.. my English is not good to explain clearly. I am sorry)

For example, the formula in “C4” is ”=IF(C3=0,"",C3-B3)”. It copies the formula into “D4” but instead of change the formula to “=IF(D3=0,"",D3-C3)”. It copies ”=IF(C3=0,"",C3-B3)” repeat to D4, E4, F4…

Code2:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim NR as Long
If Not Intersect(Target, Range("C2")) Is Nothing Then
NR = Range("D" & Cells(Columns.Count).Column).End(xlToLeft).Column + 1
Range"("D" & NR).Value = Range("C2").Value
If NR > 60 Then Range("D2").Delete xlShiftToLeft
End If
End Sub

For the code2, I did change it and put as objects into sheet1. But I could not be able to tweak the code from Row to Column. Every strings I change it give me error.

My knowledge in Excel is very basic. I have tried to do it for the whole yesterday until today. I still could not make it work. Please kindly help me with those issues.

Thank you very much and wish god bless you for your kindness.

Best regards,
Kittikorn

 

[jbeaucaire]

When working with rows, the NR and RANGE() method is great.
To work with columns, NC (next column) and the CELLS() method must be used. The example I gave above in #45 shows this, but your code2 in #47 is using RANGE() again, which won't work.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NC as Long

If Not Intersect(Target, Range("C2")) Is Nothing Then
    Application.EnableEvents = False
    NC = Cells(2, Columns.Count).End(xlToLeft).Column + 1
    Cells(2, NC).Value = Range("C2").Value
    If NC >= 60 Then Range("D2").Delete xlShiftToLeft
    Application.EnableEvents = True
End If

End Sub

To copy the formula and have it adjust relatively, you'll have to use the COPY method. This one line

Sheets("Sheet1").Cells(4, Columns.Count).End(xlToLeft).Offset(0, 1).Formula = Range("C4").Formula

Becomes these two lines:

Range("C4").Copy
Sheets("Sheet1").Cells(4, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteFormulas

Also, before you start the time again, you'll want to add this:

Application.CutCopyMode=False

 

[bpond]

Dear jbeaucaire,

Thanks to you again. The word "Thank you" is not enough to explain how I appreciate your help.
I have leant a lot from your lesson. Now I am be able to tweak the code to the way it need.

For the code below, do I need to put it? Because I don't where to put the code. So I tried to put it to many places that I guess it should be.
But I feel it make no different. The file is still function probably.

Also, before you start the time again, you'll want to add this:

Code:
Application.CutCopyMode=False

Place1:

Private Sub StartREC_Click()
Application.CutCopyMode=False
Call StartTimer
End Sub

Place2:

Sub ValueStore()
Dim dTime As Date
Sheets("Sheet1").Cells(2, Columns.Count).End(xlToLeft).Offset(0, 1).Value = Range("C2").Value
Sheets("Sheet1").Cells(3, Columns.Count).End(xlToLeft).Offset(0, 1).Value = Range("C3").Value
Range("C4").Copy
Sheets("Sheet1").Cells(4, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteFormulas
Application.CutCopyMode=False
Call StartTimer
End Sub

Place3:

Sub StopTimer()
On Error Resume Next
Application.OnTime dTime, "ValueStore", Schedule:=False
Application.CutCopyMode=False
End Sub


Cloud you please tell me which one the correct one?

Thanks again :')

Best regards,
Kittikorn

 

[bpond]

Dear jbeaucaire,

I make 2 excel files and it work great as I expect.

File1: Auto Delete to Left.xlsm

I put the code as objects

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NC As Long

If Not Intersect(Target, Range("C2")) Is Nothing Then
Application.EnableEvents = False
NC = Cells(2, Columns.Count).End(xlToLeft).Column + 1
Cells(2, NC).Value = Range("C2").Value
If NC >= 10 Then Range("D2").Delete xlShiftToLeft
Application.EnableEvents = True
End If

If Not Intersect(Target, Range("C3")) Is Nothing Then
Application.EnableEvents = False
NC = Cells(3, Columns.Count).End(xlToLeft).Column + 1
Cells(3, NC).Value = Range("C3").Value
If NC >= 10 Then Range("D3").Delete xlShiftToLeft
Application.EnableEvents = True
End If

If Not Intersect(Target, Range("C4")) Is Nothing Then
Application.EnableEvents = False
NC = Cells(4, Columns.Count).End(xlToLeft).Column + 1
Cells(4, NC).Value = Range("C4").Value
If NC >= 10 Then Range("D4").Delete xlShiftToLeft
Application.EnableEvents = True
End If

End Sub


File2: Auto Copy to Right.xlsm

I put the code as modules.


Option Explicit
Public dTime As Date

Sub ValueStore()
Dim dTime As Date
Sheets("Sheet1").Cells(2, Columns.Count).End(xlToLeft).Offset(0, 1).Value = Range("C2").Value
Sheets("Sheet1").Cells(3, Columns.Count).End(xlToLeft).Offset(0, 1).Value = Range("C3").Value
Range("C4").Copy
Sheets("Sheet1").Cells(4, Columns.Count).End(xlToLeft).Offset(0, 1).PasteSpecial xlPasteFormulas
Call StartTimer
End Sub

Sub StartTimer()
dTime = Now + TimeValue("00:00:05")
Application.OnTime dTime, "ValueStore", Schedule:=True
End Sub

Sub StopTimer()
On Error Resume Next
Application.OnTime dTime, "ValueStore", Schedule:=False
End Sub


Both files work as I expect. However, when I tried to combine them into one file. I copies data from C2, C3, C4 ==> D2,D3,D4 then E2,E3,E4. So the code as modules is function good.

But the code as objects is not working. It copies data to the right column forever. It is not delete and shift back when it reach the limit column as it set.

I am not sure that the way I combine those 2 codes into one file, it is correct or not. Please kindly advice me on the issue.

Have lovely day ^^

Yours sincerely,
Kittikorn