Capture live dynamic data as a static value at a specific time

[brutusmc99]

Hi, is there a way to grab live dynamic stock price data from column A at specific time intervals? For example, I would like to grab the price data every 15 minutes and place each value in its own column, so columns B+n? So, the price at 9:30 am would be in B, the price at 9:45 would be in C, and so on. Of course, the grabbed values should remain static in their respective columns. Any help would be appreciated. Thank you.

 

[Jeffrey Mahoney]

OK, here goes, you asked for it!

I created a dummy worksheet with two named ranges that the macro uses. CurrentStockPriceRng is the range with the stock prices. StockTimes is the row of times you want to save your static stock prices. The macro looks at the times and checks if the columns are empty and the time is in the future. It then schedules StockStatic SUB to get the current stock prices and copie them to the correct column. Then repeat. Ignore the formulas with the dummy stock prices, that was just for testing.

Book3
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	Current Price	10:10	10:11	10:12	10:13	10:14	10:15	10:16	10:17	10:18	10:19	10:20	10:21
2	198.52
3	252.14
4	352.21
5	103
6	146.1
7	66.1
8	152.41
Stock Price Data

Cell Formulas
Range	Formula
C1:M1	C1	=+B1+0.000694444444444442
A2	A2	=146.52+SECOND(NOW())
A3	A3	=200.14+SECOND(NOW())
A4	A4	=300.21+SECOND(NOW())
A5	A5	=51+SECOND(NOW())
A6	A6	=94.1+SECOND(NOW())
A7	A7	=14.1+SECOND(NOW())
A8	A8	=100.41+SECOND(NOW())

Named Ranges
Name	Refers To	Cells
StockTimes	='Stock Price Data'!$B$1:$M$1	C1

Put this code in a standard VBA module

Public SavedTime As Date
Public TimeRng As Range
Public TimeChosen As Range
Public StockSht As Worksheet


Sub StaticStockPrices()
  Dim Cel As Range
  
  Set StockSht = Sheets("Stock Price Data")
  Set TimeRng = StockSht.Range("StockTimes")
  
                          'Look for time with empty values below
  For Each Cel In TimeRng
    Debug.Print Format(Cel.Value, "hh:mm")
    If Cel.Offset(1, 0) = "" And Int(Now()) + Cel.Value > Now() Then   'must be after current time
      SavedTime = Int(Now()) + Cel.Value
      Set TimeChosen = Cel
      Exit For
    End If
  Next Cel
  
  If SavedTime > 0 Then
    Application.OnTime SavedTime, "StockStatic", schedule:=True
  End If
  
End Sub


Sub StockStatic()

  Dim OutRng As Range
  Dim StockRng As Range
  
  If SavedTime = 0 Then Exit Sub        'VBA was reset, variables zeroed
  'Application.OnTime SavedTime, "StockStatic", schedule:=False
  
  Set StockRng = StockSht.Range("CurrentStockPriceRng")   'Named Range you create
  Set OutRng = StockSht.Range(TimeChosen.Offset(1, 0), TimeChosen.Offset(StockRng.Rows.Count, 0))
  OutRng.Value = StockRng.Value     'Copy to next time
  
  SavedTime = 0
    
  Call StaticStockPrices      'Repeat
  
End Sub

Sub StopStockStatic()
  On Error Resume Next
  Application.OnTime SavedTime, "StockStatic", schedule:=False
  On Error GoTo 0

End Sub

Put this code in ThisWorkbook module

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  On Error Resume Next
  Application.OnTime SavedTime, "StockStatic", schedule:=False
  On Error GoTo 0
End Sub

 

[brutusmc99]

OK, here goes, you asked for it!

I created a dummy worksheet with two named ranges that the macro uses. CurrentStockPriceRng is the range with the stock prices. StockTimes is the row of times you want to save your static stock prices. The macro looks at the times and checks if the columns are empty and the time is in the future. It then schedules StockStatic SUB to get the current stock prices and copie them to the correct column. Then repeat. Ignore the formulas with the dummy stock prices, that was just for testing.

Book3
	A	B	C	D	E	F	G	H	I	J	K	L	M
1	Current Price	10:10	10:11	10:12	10:13	10:14	10:15	10:16	10:17	10:18	10:19	10:20	10:21
2	198.52
3	252.14
4	352.21
5	103
6	146.1
7	66.1
8	152.41
Stock Price Data

Cell Formulas
Range	Formula
C1:M1	C1	=+B1+0.000694444444444442
A2	A2	=146.52+SECOND(NOW())
A3	A3	=200.14+SECOND(NOW())
A4	A4	=300.21+SECOND(NOW())
A5	A5	=51+SECOND(NOW())
A6	A6	=94.1+SECOND(NOW())
A7	A7	=14.1+SECOND(NOW())
A8	A8	=100.41+SECOND(NOW())

Named Ranges
Name	Refers To	Cells
StockTimes	='Stock Price Data'!$B$1:$M$1	C1

Put this code in a standard VBA module

Public SavedTime As Date
Public TimeRng As Range
Public TimeChosen As Range
Public StockSht As Worksheet


Sub StaticStockPrices()
  Dim Cel As Range
 
  Set StockSht = Sheets("Stock Price Data")
  Set TimeRng = StockSht.Range("StockTimes")
 
                          'Look for time with empty values below
  For Each Cel In TimeRng
    Debug.Print Format(Cel.Value, "hh:mm")
    If Cel.Offset(1, 0) = "" And Int(Now()) + Cel.Value > Now() Then   'must be after current time
      SavedTime = Int(Now()) + Cel.Value
      Set TimeChosen = Cel
      Exit For
    End If
  Next Cel
 
  If SavedTime > 0 Then
    Application.OnTime SavedTime, "StockStatic", schedule:=True
  End If
 
End Sub


Sub StockStatic()

  Dim OutRng As Range
  Dim StockRng As Range
 
  If SavedTime = 0 Then Exit Sub        'VBA was reset, variables zeroed
  'Application.OnTime SavedTime, "StockStatic", schedule:=False
 
  Set StockRng = StockSht.Range("CurrentStockPriceRng")   'Named Range you create
  Set OutRng = StockSht.Range(TimeChosen.Offset(1, 0), TimeChosen.Offset(StockRng.Rows.Count, 0))
  OutRng.Value = StockRng.Value     'Copy to next time
 
  SavedTime = 0
   
  Call StaticStockPrices      'Repeat
 
End Sub

Sub StopStockStatic()
  On Error Resume Next
  Application.OnTime SavedTime, "StockStatic", schedule:=False
  On Error GoTo 0

End Sub

Put this code in ThisWorkbook module

Private Sub Workbook_BeforeClose(Cancel As Boolean)
  On Error Resume Next
  Application.OnTime SavedTime, "StockStatic", schedule:=False
  On Error GoTo 0
End Sub

Hi, thank you for the quick reply. I really appreciate it. I might have a few follow-up questions after I try and apply it. Hope that's okay. Cheers.