How to Collect Real Time Data Automatically (every few seconds) and save in excel column

[KenTClark]

Hey Everyone,

First off, great discussion and help you guys provide here, cheers to all!!!

I already tried searching for something similar to what I want to do with stock index real time quotes in the forum but unfortunately couldn't find. Its a pretty simple concept I think:

Now that excel has built in real time data for stocks from their cloud business, excel can retrieve updated stock or index prices in a specified cell, every time you hit refresh.

How can I automatically ask excel to record the time and price, daily high, daily low in the rows below, at every second or minute interval ? By 4 pm I would have a dataset for the entire day collected in the same worksheet? (Please see example picture)

Right now I'm just recording the values manually whenever i have time, which is not ideal . If this can be automatically recorded in excel in the background that would be great!!! I think the data refresh rate can be changed, instead of having to press the update button, I'm also looking in to that.


I already tried copying a similar program from an (old thread~2010?) into my excel VBA and after enabling macros, excel crashes and i can't even open the test file. So that's why I'm reposting.

"Private Sub Worksheet_Calculate()
capturerow = 2

currow = Range("A65536").End(xlUp).Row

Cells(currow + 1, 1) = Cells(capturerow, 1)
Cells(currow + 1, 2) = Cells(capturerow, 2)
Cells(currow + 1, 3) = Cells(capturerow, 3)
End Sub"


Thank you for your assistance!!
Best Regards,
KC

 

[igold]

Hi KenTClark, welcome to the MrExcel Forum...

From this video by Bill Jelen (MrExcel), I was able to alter his code to do other stuff, including how often you want excel to update, and not have to wait for the five minute auto refresh. I have not looked at your requirements I am only trying to show you a path to a more frequent update that may help you.

 

[KenTClark]

Hello ,

Yes that's pretty much what I need Thank you for sharing!!! I'm just stuck on one final thing. I can't get the value from an equation to print in column 5, where i just want to find the difference/Range between the high and the low values . Using the syntax in the video, I'm thinking the equation should be = "=RC[-2] - RC[-1]", but I'm not sure if i have it all correct? I am assuming RC is the current row and column?

Much Appreciated !!
KC

Sub SaveThePrice()
    Dim WS As Worksheet
    Set WS = ThisWorkbook.Worksheets(1)
    WS.Cells(1, 1).RefreshLinkedDataType
    DoEvents
    WS.Cells(2, 1).Value = Now
    NextRow = WS.Cells(Rows.Count, 1).End(xlUp).Row + 1
    WS.Cells(NextRow, 1).Resize(1, 4).Value = Array(WS.Cells(2, 1).Value, WS.Cells(2, 2).Value, WS.Cells(2, 3).Value, WS.Cells(2, 4).Value)
    WS.Cells(NextRow, 5).FormulaRange = "=RC[-2]-RC[-1][B]"[/B]
    If WS.Cells(1, 9).Value = True Then
        Exit Sub
    Else
    Application.OnTime Now + TimeValue("00:01:00"), "SaveThePrice"
    End If
    
End Sub

 

[igold]

Try This...

Sub SaveThePrice()

        Dim WS As Worksheet, NextRow As Long
        
        Set WS = ThisWorkbook.Worksheets(1)
        WS.Cells(1, 1).RefreshLinkedDataType
        DoEvents
        WS.Cells(2, 1).Value = Now
        NextRow = WS.Cells(Rows.Count, 1).End(xlUp).Row + 1
        WS.Cells(NextRow, 1).Resize(1, 4).Value = Array(WS.Cells(2, 1).Value, WS.Cells(2, 2).Value, WS.Cells(2, 3).Value, WS.Cells(2, 4).Value)
        WS.Cells(NextRow, 5) = Cells(NextRow, 3) - Cells(NextRow, 4)
        If WS.Cells(1, 9).Value = True Then
            Exit Sub
        Else
        Application.OnTime Now + TimeValue("00:01:00"), "SaveThePrice"
        End If
    
End Sub

 

[KenTClark]

yes it works now

however, there's a new issue with the macro running on its own for some reason. After I run it and one line is printed and waiting for the next line, it stops and an error pops up:

cannot run the macro "https://d.doc.live.net....etc.etc filename.xlsm'savetheprice'. The macro may not be available in this workbook or all macros maybe disabled.

Come to think of it, it never got to line 2 yesterday either. I just had to manually restart the macro to get the next line to print. Any insight into why this is happening?

Thanks again for your assistance! Cheers

Kind Regards,
KC

 

[igold]

I have re-opened my workbook that I created for you. It is running fine. I am going to let it update for three minutes and post it.

Stock Prices.xlsm
	A	B	C	D	E	F	G	H
1	S&P 500 INDEX	real time price	high	low				Run
2	8/17/2022 13:23	$ 4,272.44	$ 4,282.37	$ 4,253.08
3
4	time	price	high	low	Range
5	8/17/2022 9:32	4305.2	4325.28	4277.77	47.51
6	8/17/2022 9:33	4305.2	4325.28	4277.77	47.51
7	8/17/2022 9:34	4305.2	4325.28	4277.77	47.51
8	8/17/2022 13:21	4273.16	4282.37	4253.08	29.29
9	8/17/2022 13:22	4272.33	4282.37	4253.08	29.29
10	8/17/2022 13:23	4272.44	4282.37	4253.08	29.29
11
Sheet1

Cell Formulas
Range	Formula
B2	B2	=A1.Price
C2	C2	=A1.High
D2	D2	=A1.Low

Are the macros enabled. You may want to close and reopen...

 

[igold]

Just for the heck of it, as it seemed kind of redundant to be looking at all the duplicate entries when the spread between the High/Low has not changed, I added a line to the code to remove those duplicate spreads. I don't know if you need to see the "Every Minute" data but here it is...

Sub SaveThePrice()

        Dim WS As Worksheet, NextRow As Long
        
        Set WS = ThisWorkbook.Worksheets(1)
        WS.Cells(1, 1).RefreshLinkedDataType
        DoEvents
        WS.Cells(2, 1).Value = Now
        NextRow = WS.Cells(Rows.Count, 1).End(xlUp).Row + 1
        WS.Cells(NextRow, 1).Resize(1, 4).Value = Array(WS.Cells(2, 1).Value, WS.Cells(2, 2).Value, WS.Cells(2, 3).Value, WS.Cells(2, 4).Value)
        WS.Cells(NextRow, 5) = Cells(NextRow, 3) - Cells(NextRow, 4)
        ActiveSheet.Range("A4:E" & NextRow).RemoveDuplicates Columns:=5, Header:=xlYes  'Remove Dupes
        If WS.Cells(1, 9).Value = True Then
            Exit Sub
        Else
        Application.OnTime Now + TimeValue("00:01:00"), "SaveThePrice"
        End If
    
End Sub

Stock Prices.xlsm
	A	B	C	D	E	F	G	H
1	S&P 500 INDEX	real time price	high	low				Run
2	8/17/2022 13:38	$ 4,276.24	$ 4,282.37	$ 4,253.08
3
4	time	price	high	low	Range
5	8/17/2022 9:32	4305.2	4325.28	4277.77	47.51
6	8/17/2022 13:21	4273.16	4282.37	4253.08	29.29
7
8
9
Sheet1

Cell Formulas
Range	Formula
B2	B2	=A1.Price
C2	C2	=A1.High
D2	D2	=A1.Low

 

[KenTClark]

Hi igold,

Thanks for helping out. I don't think there is anything wrong with the code it is essentially same as what you have there and I have macros enabled when the file is opened. Like I mentioned, the macros runs and prints one row successfully but does not do it the second time . It just gives that error and I have to manually click run in the macros windows for it to "restart", so each line you see in my screen shot I had to manually run the macros. I chose different macros security settings and its still giving the same problem . I'm not sure where else i can change macros settings or security.

Thanks,
KC

 

[KenTClark]

Hi igold,

Thanks for helping out. I don't think there is anything wrong with the code it is essentially same as what you have there and I have macros enabled when the file is opened. Like I mentioned, the macros runs and prints one row successfully but does not do it the second time . It just gives that error and I have to manually click run in the macros windows for it to "restart", so each line you see in my screen shot I had to manually run the macros. I chose different macros security settings and its still giving the same problem . I'm not sure where else i can change macros settings or security.

Thanks,
KC

also here is the code i copied right from the VBA window

Sub SaveThePrice()
    Dim WS As Worksheet
    Set WS = ThisWorkbook.Worksheets(1)
    WS.Cells(1, 1).RefreshLinkedDataType
    DoEvents
    WS.Cells(2, 1).Value = Now
    Nextrow = WS.Cells(Rows.Count, 1).End(xlUp).Row + 1
    WS.Cells(Nextrow, 1).Resize(1, 4).Value = Array(WS.Cells(2, 1).Value, WS.Cells(2, 2).Value, WS.Cells(2, 3).Value, WS.Cells(2, 4).Value)
    WS.Cells(Nextrow, 5) = Cells(Nextrow, 3) - Cells(Nextrow, 4)
    If WS.Cells(1, 9).Value = True Then
        Exit Sub
    Else
    Application.OnTime Now + TimeValue("00:00:30"), "SaveThePrice"
    End If
    
End Sub

 

[KenTClark]

I

Hi igold,

Thanks for helping out. I don't think there is anything wrong with the code it is essentially same as what you have there and I have macros enabled when the file is opened. Like I mentioned, the macros runs and prints one row successfully but does not do it the second time . It just gives that error and I have to manually click run in the macros windows for it to "restart", so each line you see in my screen shot I had to manually run the macros. I chose different macros security settings and its still giving the same problem . I'm not sure where else i can change macros settings or security.

Thanks,
KC