Macro to record a cell value at specific times

I'm looking to write a macro that records a cell's value (call this price) when a cell displaying the current time is matched against a list of times in column A.

I started by putting a list of times in column A and thought if I could write a macro that said "If cell "time" is found in column A then copy cell "price" and paste special -> values to the same row in column B, but I'm really struggling to come up with any meaningful code.

If anyone could provide any assistance, it would be very much appreciated.
Cafe_PomboAsked:
Who is Participating?
 
Hitesh ManglaniConnect With a Mentor Commented:
Sub a()
For i=1 to Sheet1.UsedRange.Rows.Count
  if Sheet1.Cells(i,1) = Now() then
           Sheet1.Cells(20,5).Copy ' the cell containing price
          Sheet1.Cells(i,2).PasteSpecial(Paste:=xlValues)
  End if
Next

End Sub
0
 
Chris BottomleyConnect With a Mentor Software Quality Lead EngineerCommented:
If you define a macro using the ontime command then you can trigger the process ... using as low a time resolution as makes sense i.e.

Sub mytime()
Application.OnTime earliesttime:=(Now + TimeValue("00:30:00")), procedure:="mytime"

    Worksheets("finalreport").Range("h7") = Now
End Sub

call the routine i.e. in the workbook open event then it recalls itself at some period every 30 mins in this case and instead of the update to H7 you can trigger your time of day checks.  i.e. checking the times in column A and making the price check.

Might give you a clue anyway.

Chris
0
 
Chris BottomleySoftware Quality Lead EngineerCommented:
i.e. in the workbook module place the following:

Private Sub Workbook_Open()
'Start the timer when the workbook is opened
    StartTimer
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
 'Terminate activity on close
    StopTimer
End Sub

and in a code module place:

Option Explicit

Public RunTime As Date
Public TimerRunning As Boolean
Sub TimerAction()

'Set variable that says when procedure should run again
' Before action ensure 10s between calls
' After action ensure 10s until next call
    RunTime = Now + TimeValue("00:00:10")

' Identify your required actions:
    Worksheets("finalreport").Range("h7") = Worksheets("finalreport").Range("h7") + 1

'Schedule procedure to run again
    Application.OnTime _
        EarliestTime:=RunTime, _
        Procedure:="TimerAction", _
        Schedule:=True

End Sub
Sub StartTimer()
'Run the procedure every 10 seconds
    RunTime = Now + TimeValue("00:00:10")
 
    If Not TimerRunning Then
        TimerRunning = True
        'Schedule procedure to run
        Application.OnTime _
            EarliestTime:=RunTime, _
            Procedure:="TimerAction", _
            Schedule:=True
    End If

End Sub
Sub StopTimer()
'Run the procedure every 10 seconds
'    RunTime = Now + TimeValue("00:00:10")
 
    If TimerRunning Then
    'Stop the Timer procedure
        Application.OnTime _
            EarliestTime:=RunTime, _
            Procedure:="TimerAction", _
            Schedule:=False
        TimerRunning = False
    End If
   
End Sub

Chris
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.