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!

 

[jbeaucaire]

Place1. Basically, when you do a COPY and then a PASTESPECIAL afterwards, it leaves the sheet with those marching ants surrounding the cell that was copied. The line of code I gave you turns off that marching ants selection effect.

 

[jbeaucaire]

This EVENT code seems to do what you want, it only add values to column I, then it starts to remove values from column D:

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

 

[bpond]

Dear jbeaucaire,

Thank you for your advice on the code (”Application.CutCopyMode=False”). Now I can see the difference as your explanation.

For the other issue (Combine both good things from 2 files into 1 file),
I want to have the code below to be the main code because I need a function start and stop timer. The code will add a real-time data from cells C2, C3, C4 to D2, D3, D4, E2, E3, E4 and so on.

But I also need to add the function deleting a cell when copy the data to the right columns reach the limit and shift all cells with data to the left. To give a last blank cell then adds the new data to it. So that why I try to combine the other code to the main code below.

Option Explicit
Public dTime As Date

Sub ValueStore()
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

I have tried to change the string and combine them by myself but always give me the error.

So please kindly help me one last time. I feel really guilty to bother you all the time.
I would like to bow you. Your help is highly appreciated.

Yours sincerely,
Kittikorn

 

[jbeaucaire]

I'm wondering if this would work for you?

Option Explicit

Sub ValueStore()
Dim NC As Long

With Sheets("Sheet1")
    NC = .Cells(2, .Columns.Count).End(xlToLeft).Column
    If NC = 10 Then .Range("C2:C4").Delete xlShiftToLeft
    .Range("C2:C4").Copy
    .Cells(2, NC).PasteSpecial xlPasteAll
End With
Application.CutCopyMode = False

Call StartTimer

End Sub

 

[bpond]

Dear jbeaucaire,

I have tried the code that you write for me. When it run, it seems VBA it is working. It select the range “C2:C4” and it give us a blink but nothing was copies to the next column.

So I added “+ 1” at the end of line 5, after .column. (NC = .Cells(2, .Columns.Count).End(xlToLeft).Column + 1)
Also changed “C2:C4” to “D2:D4” on line 6 (If NC >= 10 Then .Range("D2:D4").Delete xlShiftToLeft)

Then I run it. It starts to copy the data from C2, C3, C4 to the next column.

But it created another issues. As cell “C2:C3” have a formula in the cell but I want to copy just the result of the formula (not copy a formula) which the previous code work that way.

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

(*To copies the formula to next column, we need only in Cell “C4” which the new code do their job well.)

And another issue is when it copies reach the limit 10. The VBA shift the column10 to the left as we want but it also continue copies the data to column11, column12.. forever.

I tried to tweak the code as below.

Option Explicit
Public dTime As Date

Sub ValueStore()
Dim NC As Long

With Sheets("Sheet1")
NC = .Cells(4, .Columns.Count).End(xlToLeft).Column + 1
.Cells(2, Columns.Count).End(xlToLeft).Offset(0, 1).Value = Range("C2").Value
.Cells(3, Columns.Count).End(xlToLeft).Offset(0, 1).Value = Range("C3").Value
If NC >= 10 Then .Range("D2:D4").Delete xlShiftToLeft
.Range("C4").Copy
.Cells(4, NC).PasteSpecial xlPasteAll
End With

Application.CutCopyMode = False

Call StartTimer
End Sub

Then I run it. I jump and say the big yes!!! Cell “C2:C3” it does as we expected. So when it reaches the limit then it shifts back to the left.

But.. It just almost works, unfortunately. When I glance at the Cell “C4”. It keep continue copies to the right column alone while the other “C2:C3” shift back.

Oh!! poor me. Again ^^"

So I tried to swap the code on line 6 with this

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

Then all cells “C2:C4” keep continue copies to the next column forever.

Please advise me what I did wrong, I feel that we almost there ^^

Cheer!!
Kittikorn

 

[jbeaucaire]

Is this better?

Sub ValueStore()
Dim NC As Long

With Sheets("Sheet1")
    NC = .Cells(2, .Columns.Count).End(xlToLeft).Column + 1
    .Cells(2, NC).Resize(2).Value = .Range("C2:C3").Value
    .Range("C4").Copy
    .Cells(4, NC).PasteSpecial xlPasteFormulas
    If NC > 10 Then .Range("D2:D4").Delete xlShiftToLeft
End With
Application.CutCopyMode = False

Call StartTimer

End Sub

 

[bpond]

Dear jbeaucaire,

Your code is perfectly work, nice and clean. Finally, I have fulfilled my dream ^^
I could not make it or getting near it without your help.

With my deeply respect, I want to say "thanks very much" to you for your kindness that you tried to help some newbie like me without complaining.
This show you have a big heart. I wish god bless you happiness. All the best to you and your :')

Have a lovely day.
Kittikorn

 

[bpond]

Dear jbeaucaire,

It is me again ^^ <o></o>
How are you? I wish you were doing great.<o></o>
Now I am trying to put the code that your help me write into my excel file project. <o></o>

In Modules ==> Module2:<o></o>

Option Explicit
Public dTime As Date

Sub ValueStore()
Dim NC As Long

With Sheets("VolCalculation")
NC = .Cells(2, .Columns.Count).End(xlToLeft).Column + 1
.Cells(2, NC).Resize(2).Value = .Range("B2:B3").Value
If NC > 21 Then .Range("C2:C3").Delete xlShiftToLeft
End With

Application.CutCopyMode = False
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

When I run this code, it works very well in “Sheet2”.<o></o>
<o></o>
But when I press the button that Created in “Sheet1” (StartTimer and StopTimer button and put the code below in each button).<o></o>
<o></o>
In Objects ==> Sheet1

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

Private Sub StopTimer_Click()
Call StopTimer
End Sub

When I press the button. It selected the line "Call StartTimer" in <acronym title="visual basic for applications">VBA</acronym> and also show this error,

Compile error:
Expected procedure, Not variable

I tried to change everything that I could guess but still could not make it work.<o></o>
Please kindly advice.<o></o>
<o></o>
With respect,<o></o>
Kiitkorn<o></o>

 

[bpond]

I figured out another solution for the issue in post #58.

I used another type of button (Form control) and assigned the macro to it.

It works ^^

But I still want to learn what did I done wrong in the code above why it shown the error.
If anyone know it, please kindly advice.

Many thanks in advance :')
Cheer

 

[jbeaucaire]

I can only guess. I never create buttons and objects with names that exactly match other procedures or builtin VBA functions.

StartTimer (button)
StartTimer (sub)

Confusion can ensue, so I don't do it.