PDA

View Full Version : Copy and Paste Values at 1 min intervals



xneurosis
01-17-2013, 01:02 AM
Hello,

I am juststarted learning VBA and needed some help on the creation of a macro to recorda set of values and put in a time stamp as well.

The spreadsheetis set up with the second row (row 2) with a value in each cell goinghorizontally, from column to column. These cells are continuously updated witha link to provide a live number of a specific values, whose names are in row 1above it.

I would like torecord each of these values at the same time, every single 1 minute timeinterval, to keep a log of them. As the values change/update, I'd like all thevalues in the 2nd row (the ones that are continuously updating) to be copiedand pasted to the row below, and in the first column (column A) have a timestamp of the exact time(every minute) that this value was recorded. At the nextminute, I want this to happen again, but this time the value pasted below thepreviously recorded/pasted row (so lets say at 12:00:00 the values are pastedin row 3, and at 12:01:00 the values are copied and pasted into row 4), so thatas time passes. a new row is formed with new snapshot values of the live cellsin row 2. I want it to be able to run continuously (infinitely recording valuesdownward) until I manually break the macro myself (I know this will be a hugeamount of data, but I can manage that).

Also, how wouldI be able to adjust the spreadsheet macro in case I decide to add even moreupdating cells in row 2, thereby using more columns to record data. So forexample, at first I'm keeping track of let's say 10 variables, range(B2:K2),but next week I want to keep track of range(B2:BB2). Is there a specific way Ican update the macro in order to run it the same, but now also incorporate thenew value recorded and time stamped, just like the others ( I realize that the timestamps for these "extra" products added in will not have thepreviously recorded data as the others would, and therefore would start waydown the rows in sync with the others based on the time I start recording), andwhere specifically would I change this value to incorporate the new range? Iwant this all contained within the same sheet of the workbook, to automaticallyrecord even as I do other stuff in other workbooks/worksheets.

This being said, I started some code, so I don’t have to start from scratch. Please seethe attached code (below) to give the best advice.

The function/macro "LastRow" was one I received from some help on anotherwebsite, to add into mine:

Private Function LastColumn(Optional ByVal Rw As Long, Optional Ws As Worksheet) As Long
' 0056 V 2.1 Apr 2, 2012
' Return the number of the last non-blank column in row Rw.
' If no row is specified,
' return the last column from row 1.
' If no worksheet is specified,
' return the result from the currently active sheet.
Dim C As Long
If Ws Is Nothing Then Set Ws = ActiveSheet
Rw = IIf(Rw, Rw, 1)
With Ws
C = .Cells(Rw, .Columns.Count).End(xlToLeft).Column
With .Cells(Rw, C)
' in a blank row the last used column is 0 (= none)
If C = 1 And .Value = vbNullString Then C = 0
' include all columns of a merged range
LastColumn = C + .MergeArea.Columns.Count - 1
End With
End With
End Function

But I don't know how to implement it accurately to get the results I want. Do Ijust add the function underneath, and which part of the code do I change to fitmy needs? I would appreciate any step by step help on this.

I also received some other code to add a time stamp to each row, but I don't know how to factorit into the macro to make it work.

Public Sub CreationDate(ByRef Target As Range)
Const CreateColumn As String = "B"
With Target
With .Worksheet.Cells(.Row, CreateColumn)
If Not IsDate(.Value) Then .Value = Date
.Offset(0, 1).Select
End With
End With
End Sub

I need help compiling this huge project to make it work efficiently.

I know how to make a button of this to initiate the macro, so that won’t be a problem.

I'm at a loss on how to do something this complex, and help or guidance would be appreciated.I hope I've been descriptive enough. Thanks!

CODE: (this is all I have so far)
SubValueStore()
Dim dTime AsDate
Dim R As Long
R = LastRow("E") + 1
Cells(R, "B").Value = Range("B2").Value
Cells(R, "C").Value = Range("C2").Value
dTime = Now + TimeValue("00:01:00")
Application.OnTime dTime, "ValueStore", Schedule:=True
End Sub

BrianMH
01-17-2013, 01:04 AM
cross post
http://www.mrexcel.com/forum/excel-questions/679814-help-needed-finished-visual-basic-applications-code-copy-paste-values-1-min-intervals.html

jolivanes
01-17-2013, 09:49 PM
and here

http://www.thecodecage.com/forumz/microsoft-excel-forum/213699-help-needed-finished-visual-basic-applications-code-copy-paste-values-1-min-intervals.html

Aussiebear
01-18-2013, 05:33 PM
Well that'll just about kill any potential assistance here

GTO
01-18-2013, 07:00 PM
Greetings,

I see that this is your first thread here and you just joined. I also caught that both here and where you cross-posted, you were advised about the cross-posts. As you just joined, I just wanted to tack in a good article that explains this in a very nice manner.

Please read here (http://www.excelguru.ca/content.php?184-A-message-to-forum-cross-posters)

For others: Also posted at... (http://www.ozgrid.com/forum/showthread.php?t=173899)

Mark

xneurosis
01-24-2013, 03:03 AM
Oh, I didn't know! Sorry for the misunderstanding!

I can't show the posts I've cross posted in! This forum will not allow me to post links unless I've posted in this forum more than 5 times!

I've cross posted in the ones you've already listed above. I've been getting some help on excelkey, but I can't paste the link here to direct you guys to it. I believe those are the only other ones.

I've made some progress from the last post here, but I'm still having problems with the code. I've explained my difficulties as well as uploaded a copy of my spreadsheet. I'd really appreciate any more help on this, its been taking way longer to finish than I've wanted it to.

Should I keep this forum post here? Or should I delete it and post a new one, this time listing all my cross posts?

xneurosis
01-24-2013, 03:08 AM
ok NOW I can post the link. Sorry again guys, I didn't know!

Here is where I've made progress on the macro but I still need help finishing it. The problem is explained if you click on this link

http://www.excelkey.com/forum/viewtopic.php?f=3&t=3032&sid=6acd5c5ef7689bfa03c25982a6c78396&p=10736#p10736

xneurosis
01-24-2013, 03:50 AM
I've made some cross posts here:
http://www.vbaexpress.com/forum/showthread.php?p=284372#post284372

http://www.thecodecage.com/forumz/microsoft-excel-forum/213699-help-needed-finished-visual-basic-applications-code-copy-paste-values-1-min-intervals.html

http://www.mrexcel.com/forum/excel-questions/679814-help-needed-finished-visual-basic-applications-code-copy-paste-values-1-min-intervals.html#post3366918

The only help I've gotten so far is here:
http://www.excelkey.com/forum/viewtopic.php?f=3&t=3032&sid=6acd5c5ef7689bfa03c25982a6c78396&p=10736#p10736

This link above has my new code, as well as an explanationof the problems I've been having. You can also download the spreadsheet to seeit for yourself.

Terribly sorry for the cross posts, it wont let me delete the post, so I'm stuck having to ask for help at risk of being banned or being ignored.

GTO
01-24-2013, 08:31 PM
Hi again,

If I am understanding what we want, to recap:

You have data being updated in row 2. Once a minute, you would like the latest data to be "copied" down to the first available/empty row below the "live" data. In looking, it appeared to me that you wanted a timehack, and I think maybe this would go with the corresponding record.

I tacked in a toggle, so we could shut off, or restart, the auto record creations...

If the above is close, does this help?

In the ThisWorkbook Module:
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Shutdown
Application.OnKey "^d"
End Sub

Private Sub Workbook_Open()
Startup
Application.OnKey "^d", "ToggleUpdating"
End Sub


In a Standard Module:

Option Explicit

Private lRightColumn As Long
Private rngLiveValues As Range
Private dtmScheduledTime As Date
Private bolUpdating As Boolean

Const INTERVAL As Double = 1.15740740740741E-04 '<--- 10 seconds, change to suit.

Sub Startup()
Dim wksGrains1MinData As Worksheet

'// Set a reference to the worksheet we are running against. Personally, I would //
'// just change the sheet's CodeName to something intuitive and use that. //
Set wksGrains1MinData = Sheet1
With wksGrains1MinData
'// No safety included for the case of no data in row 1. As long as that is no //
'// issue, it appeared to me that we could count on row 1 to define the last //
'// currently used column. //
lRightColumn = RangeFound(.Rows(1), , .Cells(1)).Column
'// Set a reference to our non-changing range that we wish to rip the live //
'// values from; hence the module level variable. //
Set rngLiveValues = .Range(.Cells(2, "B"), .Cells(2, lRightColumn))
End With

bolUpdating = True
Call Main
End Sub

Sub Shutdown()
KillTimer
bolUpdating = False
End Sub

Sub ToggleUpdating()
'// Using a module level flag, toggle updating with our shortcut key combo //
If Not bolUpdating Then
Startup
Else
Shutdown
End If
End Sub

Sub Main()
Dim rngSearchRange As Range
Dim lOpenRow As Long

With Sheet1
'// Find a cell in the last row with data in it. If there is no initial "live" //
'// data, bailout. //
Set rngSearchRange = RangeFound(rngLiveValues.Resize(.Rows.Count - 1))
If rngSearchRange Is Nothing Then
MsgBox "ACK!"
KillTimer
Exit Sub
End If

'***just for demo, to provide "live" data*****************
Randomize '*
'Int((upperbound - lowerbound + 1) * Rnd + lowerbound) '*
rngLiveValues.Value = Int((1000 - 10 + 1) * Rnd + 10) '*
'*********************************************************

lOpenRow = rngSearchRange.Row + 1
'// Update first open row with data and enter time in column 1 //
.Range(.Cells(lOpenRow, 2), .Cells(lOpenRow, lRightColumn)).Value = rngLiveValues.Value
.Cells(lOpenRow, 1).Value = Time

dtmScheduledTime = Now() + CDate(INTERVAL)
ResetTimer dtmScheduledTime
End With
End Sub

Sub ResetTimer(NextTime As Date)
Application.OnTime NextTime, "Main"
End Sub

Sub KillTimer()
On Error Resume Next
Application.OnTime dtmScheduledTime, "Main", , False
On Error GoTo 0
End Sub

Function RangeFound(SearchRange As Range, _
Optional ByVal FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function

See attached wb.

Hope that helps,

Mark

smehra
06-22-2018, 03:51 AM
Hi again,

If I am understanding what we want, to recap:

You have data being updated in row 2. Once a minute, you would like the latest data to be "copied" down to the first available/empty row below the "live" data. In looking, it appeared to me that you wanted a timehack, and I think maybe this would go with the corresponding record.

I tacked in a toggle, so we could shut off, or restart, the auto record creations...

If the above is close, does this help?

In the ThisWorkbook Module:
Option Explicit

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Shutdown
Application.OnKey "^d"
End Sub

Private Sub Workbook_Open()
Startup
Application.OnKey "^d", "ToggleUpdating"
End Sub


In a Standard Module:

Option Explicit

Private lRightColumn As Long
Private rngLiveValues As Range
Private dtmScheduledTime As Date
Private bolUpdating As Boolean

Const INTERVAL As Double = 1.15740740740741E-04 '<--- 10 seconds, change to suit.

Sub Startup()
Dim wksGrains1MinData As Worksheet

'// Set a reference to the worksheet we are running against. Personally, I would //
'// just change the sheet's CodeName to something intuitive and use that. //
Set wksGrains1MinData = Sheet1
With wksGrains1MinData
'// No safety included for the case of no data in row 1. As long as that is no //
'// issue, it appeared to me that we could count on row 1 to define the last //
'// currently used column. //
lRightColumn = RangeFound(.Rows(1), , .Cells(1)).Column
'// Set a reference to our non-changing range that we wish to rip the live //
'// values from; hence the module level variable. //
Set rngLiveValues = .Range(.Cells(2, "B"), .Cells(2, lRightColumn))
End With

bolUpdating = True
Call Main
End Sub

Sub Shutdown()
KillTimer
bolUpdating = False
End Sub

Sub ToggleUpdating()
'// Using a module level flag, toggle updating with our shortcut key combo //
If Not bolUpdating Then
Startup
Else
Shutdown
End If
End Sub

Sub Main()
Dim rngSearchRange As Range
Dim lOpenRow As Long

With Sheet1
'// Find a cell in the last row with data in it. If there is no initial "live" //
'// data, bailout. //
Set rngSearchRange = RangeFound(rngLiveValues.Resize(.Rows.Count - 1))
If rngSearchRange Is Nothing Then
MsgBox "ACK!"
KillTimer
Exit Sub
End If

'***just for demo, to provide "live" data*****************
Randomize '*
'Int((upperbound - lowerbound + 1) * Rnd + lowerbound) '*
rngLiveValues.Value = Int((1000 - 10 + 1) * Rnd + 10) '*
'*********************************************************

lOpenRow = rngSearchRange.Row + 1
'// Update first open row with data and enter time in column 1 //
.Range(.Cells(lOpenRow, 2), .Cells(lOpenRow, lRightColumn)).Value = rngLiveValues.Value
.Cells(lOpenRow, 1).Value = Time

dtmScheduledTime = Now() + CDate(INTERVAL)
ResetTimer dtmScheduledTime
End With
End Sub

Sub ResetTimer(NextTime As Date)
Application.OnTime NextTime, "Main"
End Sub

Sub KillTimer()
On Error Resume Next
Application.OnTime dtmScheduledTime, "Main", , False
On Error GoTo 0
End Sub

Function RangeFound(SearchRange As Range, _
Optional ByVal FindWhat As String = "*", _
Optional StartingAfter As Range, _
Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
Optional LookAtWholeOrPart As XlLookAt = xlPart, _
Optional SearchRowCol As XlSearchOrder = xlByRows, _
Optional SearchUpDn As XlSearchDirection = xlPrevious, _
Optional bMatchCase As Boolean = False) As Range

If StartingAfter Is Nothing Then
Set StartingAfter = SearchRange(1)
End If

Set RangeFound = SearchRange.Find(What:=FindWhat, _
After:=StartingAfter, _
LookIn:=LookAtTextOrFormula, _
LookAt:=LookAtWholeOrPart, _
SearchOrder:=SearchRowCol, _
SearchDirection:=SearchUpDn, _
MatchCase:=bMatchCase)
End Function

See attached wb.

Hope that helps,

Mark

nitinbg
04-21-2019, 12:19 PM
Hello Guys,

This is my first post since joining. I am new baby to VBA but last 4 days I am just trying to create 1 VBA code. Since I was not able to create the code so searched online and reached here n this site.
I found nearly same qustion what I was looking for. But I require some changes in the code.
I wanted to remove rngLiveValues code from the VBAcode. I wanted to link some other data in Row 2.
My english is not that good so please ask if you have questions.

jolivanes
04-21-2019, 12:54 PM
@nitinbg
Please do not "hijack", which is starting your thread in someone else's thread.
Start your own thread.