Consulting

Results 1 to 12 of 12

Thread: Copy and Paste Values at 1 min intervals

  1. #1

    Copy and Paste Values at 1 min intervals

    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:

    [VBA]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[/VBA]

    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.

    [VBA]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[/VBA]

    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)
    [VBA]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[/VBA]
    Attached Files Attached Files
    Last edited by Aussiebear; 01-18-2013 at 05:32 PM. Reason: added the correct tags to the supplied code

  2. #2
    VBAX Mentor
    Joined
    Feb 2009
    Posts
    493
    Location
    -----------------------------------------
    The more you learn about something the more you know you have much to learn.

  3. #3

  4. #4
    Moderator VBAX Guru Aussiebear's Avatar
    Joined
    Dec 2005
    Location
    Queensland
    Posts
    3,819
    Location
    Well that'll just about kill any potential assistance here
    Remember To Do the Following....
    Use tags when posting code to the thread,
    Mark your thread as Solved if satisfied by using the Thread Tools options.
    If posting the same issue to another forum please show the link

  5. #5
    Knowledge Base Approver VBAX Guru GTO's Avatar
    Joined
    Sep 2008
    Posts
    3,362
    Location
    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

    For others: Also posted at...

    Mark

  6. #6

    Sorry!

    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?

  7. #7
    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/viewto...p=10736#p10736

  8. #8
    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#p1073 6

    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.

  9. #9
    Knowledge Base Approver VBAX Guru GTO's Avatar
    Joined
    Sep 2008
    Posts
    3,362
    Location
    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:
    [VBA]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
    [/VBA]

    In a Standard Module:
    [VBA]
    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[/VBA]

    See attached wb.

    Hope that helps,

    Mark
    Attached Files Attached Files

  10. #10
    VBAX Newbie
    Joined
    Jun 2018
    Posts
    1
    Location

    Thanks

    Quote Originally Posted by GTO View Post
    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:
    [VBA]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
    [/VBA]

    In a Standard Module:
    [VBA]
    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[/VBA]

    See attached wb.

    Hope that helps,

    Mark

  11. #11
    VBAX Newbie
    Joined
    Apr 2019
    Posts
    1
    Location
    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.
    Attached Files Attached Files

  12. #12
    VBAX Expert
    Joined
    Apr 2005
    Posts
    745
    Location
    @nitinbg
    Please do not "hijack", which is starting your thread in someone else's thread.
    Start your own thread.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •