Data acquisition from the web

[Rudi]

Hmmm...yes, Power Query only works from Excel 2010 onwards.

I went the old legacy route.
This version works for me. Hope it will do the same for you.

totalpc (Web).xlsm

[bknight]

That does work, but how would I incorporate just the code into the present code presented earlier? Makes not opening another SS during the data acquisition.

[Rudi]

I never reviewed that lengthy "previous macro" which you say deletes maximum character limit? I have no idea what that is for and if it is part of the process of getting data from the web page.

The workbook I posted contains the import of the entire web page to a table on the Data sheet. The macro triggers a refresh on this table and then collects the values from the calculated cells to append them to the bottom of your list. If you move the Data sheet into your actual workbook and copy the macro into a module, things should work fine barring your list structure mimics the one in your sample file you attached previously.

I'm happy to assist in integrating the functionality into your actual file if it is not confidential.

[bknight]

I never reviewed that lengthy "previous macro" which you say deletes maximum character limit? I have no idea what that is for and if it is part of the process of getting data from the web page.

The workbook I posted contains the import of the entire web page to a table on the Data sheet. The macro triggers a refresh on this table and then collects the values from the calculated cells to append them to the bottom of your list. If you move the Data sheet into your actual workbook and copy the macro into a module, things should work fine barring your list structure mimics the one in your sample file you attached previously.

I'm happy to assist in integrating the functionality into your actual file if it is not confidential.

I have in the past, when I was working on a copy procedure, posted a smaller version of the workbook. It is now 3.3 MB and even zipping it wouldn't pass the limit. It isn't confidential by any means, just capturing nonproprietary data and the copy one line of cells containing formulas from previous day to current day. The code is long, I agree, but the only part that is at the issue of the thread is labelled Sub CopyCellsFormulas() then goto line 36 for the beginning of part at issue ' PutCall Ratio. Nothing (in my reviewing the code) has any variable previously declared prior to line 36.

Code: Select all

Sub CopyCellsFormulas()
Dim dteDateValue As Date
Dim I As Integer, J As Integer, intStartRow As Integer, R As Integer
Dim Lr As Long, Sr As Long, Cntrw As Long
Dim dbl9Value As Double, dbl21Value As Double
Dim Temp() As Variant
Dim rngWs As Range
Dim arrrngWs() As Variant
Dim ws As Worksheet
Const defName As String = "DataCol"
Const defNameOEX_High As String = "OEX_High"
Const defNameOEX_Low As String = "OEX_Low"
Const defNameDATE_Range As String = "DATE_Range"

    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
' Vix
 Set ws = Worksheets("Vix")
 Worksheets("Vix").Activate
 ws.Activate
 Let Lr = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
 Let Sr = (ws.Cells(ws.Rows.Count, "F").End(xlUp).Row) + 1
 Let Temp() = Worksheets("Vix").Range("F" & (Sr - 1) & ":I" & (Sr - 1) & "").Formula
 Let Temp() = Worksheets("Vix").Range("F" & Sr - 1 & ":I" & Sr - 1 & "").Formula
 Set rngWs = Worksheets("Vix").Range("F" & Sr & ":I" & Lr & "")
 ReDim arrrngWs(1 To rngWs.Rows.Count, 1 To 4)
    For Cntrw = 1 To (UBound(arrrngWs(), 1) - 0)
     Let arrrngWs(Cntrw, 1) = "=(F" & Sr - 2 + Cntrw & "*$I$3)+(E" & Sr - 1 + Cntrw & "*$I$2)" '
     Let arrrngWs(Cntrw, 2) = "=G" & Sr - 2 + Cntrw & "*$I$7+E" & Sr - 1 + Cntrw & "*$I$6"     '
     Let arrrngWs(Cntrw, 3) = "=F" & Sr - 1 + Cntrw & "/G" & Sr - 1 + Cntrw & ""             '
     Let arrrngWs(Cntrw, 4) = "=AVERAGE(E" & Sr - 50 + Cntrw & ":E" & Sr - 1 + Cntrw & ")"   '
    Next Cntrw
 Let rngWs.Value = arrrngWs()
Cells(Lr + 1, 2).Select
' PutCall Ratio
Set ws = Worksheets("PutCall Ratio")
Worksheets("PutCall Ratio").Activate
Let Lr = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row
Let Sr = (ws.Cells(ws.Rows.Count, "F").End(xlUp).Row) + 1
Set rngWs = Worksheets("PutCall Ratio").Range("F" & Sr & ":H" & Lr & "")
ReDim arrrngWs(1 To rngWs.Rows.Count, 1 To 3)
    For Cntrw = 1 To (UBound(arrrngWs(), 1) - 0)
     Let arrrngWs(Cntrw, 1) = "=(F" & Sr - 2 + Cntrw & "*$I$3)+(E" & Sr - 1 + Cntrw & "*$I$2)" '
     Let arrrngWs(Cntrw, 2) = "=(G" & Sr - 2 + Cntrw & "*$I$7)+(E" & Sr - 1 + Cntrw & "*$I$6)"
     Let arrrngWs(Cntrw, 3) = "=F" & Sr - 1 + Cntrw & "/G" & Sr - 1 + Cntrw & ""             '
    Next Cntrw
Let rngWs.Value = arrrngWs()

Set rngWs = Worksheets("PutCall Ratio").Range("K" & Sr & ":L" & Lr & "")
ReDim arrrngWs(1 To rngWs.Rows.Count, 1 To 2) 
    For Cntrw = 1 To (UBound(arrrngWs(), 1) - 0)
     Let arrrngWs(Cntrw, 1) = "=AVERAGE(E" & Sr - 9 + Cntrw & ":E" & Sr - 2 + Cntrw & ")"
     Let arrrngWs(Cntrw, 2) = "=AVERAGE(E" & Sr - 21 + Cntrw & ":E" & Sr - 2 + Cntrw & ")"
    Next Cntrw
Let rngWs.Value = arrrngWs() ' This will paste out the Formula values to the Worksheet
rngWs.NumberFormat = "0.00"
Cells(Lr + 1, 2).Select

'OEX
Set ws = Worksheets("OEX")
Worksheets("OEX").Activate
Let Lr = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
Let Sr = (ws.Cells(ws.Rows.Count, "H").End(xlUp).Row) + 1
Set rngWs = Worksheets("OEX").Range("H" & Sr & ":H" & Lr & "")
ReDim arrrngWs(1 To rngWs.Rows.Count, 1 To 1)
    For Cntrw = 1 To (UBound(arrrngWs(), 1) - 0)
     Let arrrngWs(Cntrw, 1) = "=(H" & Sr - 2 + Cntrw & "* $I$4) + (F" & Sr - 1 + Cntrw & "* $i$3)"
    Next Cntrw
Let rngWs.Value = arrrngWs() ' This will paste out the Formula values to the Worksheet
Cells(Lr + 1, 3).Select
    R = ws.Cells(Rows.Count, "D").End(xlUp).Row
    ActiveWorkbook.Names.Add Name:=defNameOEX_High, RefersTo:="=" & ActiveSheet.Name & "!" & Range("D2", Cells(R + 1, "D")).Address
    R = ws.Cells(Rows.Count, "E").End(xlUp).Row
    ActiveWorkbook.Names.Add Name:=defNameOEX_Low, RefersTo:="=" & ActiveSheet.Name & "!" & Range("E2", Cells(R + 1, "E")).Address
    R = ws.Cells(Rows.Count, "A").End(xlUp).Row
    ActiveWorkbook.Names.Add Name:=defNameDATE_Range, RefersTo:="=" & ActiveSheet.Name & "!" & Range("A2", Cells(R + 1, "A")).Address
Dim LDteVal2 As Double
 Let LDteVal2 = ws.Cells(Lr, 1).Value2 ' .Value 2 date Number for last Filled in row
Set ws = Worksheets("Calc")
Worksheets("Calc").Activate
Let Lr = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
Let Sr = (ws.Cells(ws.Rows.Count, "C").End(xlUp).Row) + 1
'Calc
For Cntrw = Lr To Sr - 1
Range(Cells(Lr, 1), Cells(Lr, 7)).Copy Range(Cells(Sr, 1), Cells(Sr, 7))
Next Cntrw
Cells(Sr, 1).Select
Selection.NumberFormat = "mm/dd/yy;@"
Cells(Sr, 5).Select
Selection.NumberFormat = "mm/dd/yyyy;@"
Cells(Sr, 1).Select
R = Cells(Rows.Count, "B").End(xlUp).Row
ActiveWorkbook.Names.Add Name:=defName, RefersTo:="=" & ActiveSheet.Name & "!" & Range("B2", Cells(R, "B")).Address
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
End Sub 'CopyCellsFormulas()

[Rudi]

Hi,

I don't know what all the functionality is doing in the original PutCall Code, but if all you need is the indicated values imported from the webpage as discussed in this thread, then the only thing you'd need to do is comment out the current PutCall code and call the new code that I provided. (See the updated code attached that calls the new RefreshPutCallRatio code).

Please note that you do need to move the Data sheet into your workbook as this is referenced in the code and is the table that links to the webpage.

New PutCall Macro.txt

[bknight]

Hi,

I don't know what all the functionality is doing in the original PutCall Code, but if all you need is the indicated values imported from the webpage as discussed in this thread, then the only thing you'd need to do is comment out the current PutCall code and call the new code that I provided. (See the updated code attached that calls the new RefreshPutCallRatio code).

Please note that you do need to move the Data sheet into your workbook as this is referenced in the code and is the table that links to the webpage.

New PutCall Macro.txt

The functionality is to reduce the number of physical steps to accomplish all the copy/paste operations. Adding the "Data" sheet won't be an issue, but To make the goal of reduced physical steps I believe that there will have to be a slight change.
Put a gosub into your suggested code where you have Call (although they may be identical).

[Rudi]

Hi,

Sorry, I cannot help with shortening or optimizing your code. I hardly understand the context of it to start with. I chipped in to assist with extracting the data from the web.
I wish you well with the rest of this project.

[bknight]

Hi,

Sorry, I cannot help with shortening or optimizing your code. I hardly understand the context of it to start with. I chipped in to assist with extracting the data from the web.
I wish you well with the rest of this project.

No problem with optimizing or shortening.
However I got an error message at
Worksheets("Data").Range("A2").QueryTable.Refresh BackgroundQuery:=False
Run time error 1004
Application defined or object defined error

Yes there is a Data worksheet present.

Where does this fit in?

Code: Select all

Private Sub GetDataWeb()
    Application.CutCopyMode = False
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;https://markets.cboe.com/us/options/market_statistics/daily", Destination _
        :=Range("$A$1"))
        .CommandType = 0
        .Name = "daily"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Selection.QueryTable.Refresh BackgroundQuery:=False
End Sub

[Rudi]

I'm assuming that when you copied the Data sheet into your template, the table got severed from the source or it lost its linked status.

Try this to fix:

On the DATA sheet, select range A2:D1228 and press the delete key to delete the cell content (do not delete rows or columns).
Choose YES when a warning message appears to indicate you will loose the table links or structure
Then run the updated code below. (Copy this code and paste it into the macro module with your other code, replacing the older version of this macro if you have a duplicate of it)
Run this macro. It will import a new version of the web page info and structure it as a linked table.

After it is imported, the formulas will update in the small table to the right.

This should resolve the issue.

Code: Select all

Private Sub GetDataWeb()
    Application.CutCopyMode = False
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;https://markets.cboe.com/us/options/market_statistics/daily", Destination _
        :=Range("$A$2"))
        '.CommandType = 0
        .Name = "daily"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Selection.QueryTable.Refresh BackgroundQuery:=False
End Sub

[bknight]

I'm assuming that when you copied the Data sheet into your template, the table got severed from the source or it lost its linked status.

Try this to fix:

On the DATA sheet, select range A2:D1228 and press the delete key to delete the cell content (do not delete rows or columns).
Choose YES when a warning message appears to indicate you will loose the table links or structure
Then run the updated code below. (Copy this code and paste it into the macro module with your other code, replacing the older version of this macro if you have a duplicate of it)
Run this macro. It will import a new version of the web page info and structure it as a linked table.

After it is imported, the formulas will update in the small table to the right.

This should resolve the issue.

Code: Select all

Private Sub GetDataWeb()
    Application.CutCopyMode = False
    With ActiveSheet.QueryTables.Add(Connection:= _
        "URL;https://markets.cboe.com/us/options/market_statistics/daily", Destination _
        :=Range("$A$2"))
        '.CommandType = 0
        .Name = "daily"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    Selection.QueryTable.Refresh BackgroundQuery:=False
End Sub

Quick answer, no I didn't copy your Data sheet I just added one into mine, sorry I misunderstood your suggestion.
I added the code in the worksheet Macros, not in a module and ran it, worked fine as it populated the sheet with a bunch of labels in column a then data beginning(yesterday) in row 1180. Hopefully it will all work later today with this adition.

[bknight]

I have a related question. In the spreadsheet that Rudi worked on for me where is the part of code that gathers the data to be used each day. I can't find it.

ETA This was a different web page and a different set of data than that asked in the OP. The codes are very different, and this spreadsheet works evryday.

[Rudi]

Glad to hear that it is working...so far...

In the latest attachment you uploaded, the code simply updated the linked table and then writes the new values to the second sheet.
There is no link to the source web-page in the code as this is all stored in the table.
If you right click on the source table (on the first sheet) you can choose "Edit Query" (or properties) which will open the import dialog. In this dialog it stores and displays the target web-page to collect the data from.

20191113_427.jpg

20191113_426.jpg

[bknight]

Thanks for finding the macro. Now for the bad news, I ran the code last night and when it encountered the Call, the code didn't delete the old data in the Data sheet, nor did it update the PutCall Sheet. It could have duplicated the previous day, but did not update 11/12/2019 data, the cells were blank.

[bknight]

In your code I did comment out this piece that was giving me the error
Worksheets("Data").Range("A2").QueryTable.Refresh BackgroundQuery:=False
I ASSUME that might be the reason that the data wasn't updated. Why the second part BackgroundQuery:=False Is the refresh part to update and then you want the macro to stop?
I don't understand this part
lRow = .Cells(1).CurrentRegion.Rows.Count + 1
.Cells(lRow, "A").Value = shSource.Range("H2").Value
.Cells(lRow, "B").Value = shSource.Range("H3").Value
.Cells(lRow, "C").Value = shSource.Range("H4").Value
.Cells(lRow, "D").Value = shSource.Range("H5").Value
.Cells(lRow, "E").Value = shSource.Range("H6").Value
Col A has Dates and is filled in already.
Col B has Call data from Data B1189
Col C has Put data from Data C1189
Col D has Total data from Data D1189
Col E has Ratio data from Data B1180
How does Range "H1--H6".Value select the correct bits of data?
We'll see how it functions this evening, thanks.

[Rudi]

Hi,

I tested the code again this morning (14 Nov. @ 6:01am) and it runs without error.

It gives me this result in the test workbook.

20191114_430.jpg

The code puts in the date (13th) and all three values in the last line.

Re. this line: Worksheets("Data").Range("A2").QueryTable.Refresh BackgroundQuery:=False

First, it must not be commented out as this line refreshes the table so that it imports the latest detail from the web page.
If it is causing an error its most likely that your sheet is not called "Data", or your table starts in a cell other than A2, or the data is not registered as a linked table that is connected to the source web page. To check the last scenario, you can right click in the table and check if your context menu has entries like "Edit Query" and "Data Range Properties".

Second, The BackgroundQuery:=False argument is set to False so that it forces the table to finish collecting and updating the data before the rest of the code runs to process the data and write it to your list.

Next, with re. to the code starting with: lRow = .Cells(1).CurrentRegion.Rows.Count + 1

Have a look at the "DATA" sheet. It contains a small table with VLOOKUP formulas.

20191114_431.jpg

These VLOOKUP's collect the necessary data into a small reference table, writing the values to cells H2:H6

20191114_432.jpg

Once these values are available, the macro finishes by transferring them to your list referred to by the lines: .Cells(lRow, "A").Value = shSource.Range("H2").Value

Lastly, re. How does Range "H1--H6".Value select the correct bits of data?
Range H2:H6 contain VLOOKUP's that locate the values in the newly imported data and deposit these target values into the cells. The macro referes to these VLOOKUP cells and copies the values to your list on the second sheet.

So, in summary:
You need to ensure you have a sheet called DATA in your workbook
This sheet must contain a query table starting in A2 that collects data from the source web page and is updated by the macro line: Worksheets("Data").Range("A2").QueryTable.Refresh BackgroundQuery:=False
The DATA sheet also must have a small table in G1:H6 that contain VLOOKUP's to extract the necessary values from the query table
Finally the macro refers to these values in the small table and writes the values to your list on the second sheet determined by the line: Set shDestination = Sheets(2). you can edit Sheets(2) to be a specificly named sheet using: Worksheets("<whatever name>)"

Hope this helps explain things more clearly.
In short, I created and sent you the process of collecting the data from the web (which was built into a separate workbook I attached). It was expected for you to move the Query Table sheet and the macros into your actual workbook and integrate the functionality to make it work in your template.

[bknight]

It still didn't work tonight, but it did refresh the correct data, but still no data transferred from data to PutCall. I believe I need to copy the Data worksheet you sent in the XLSM file. My data sheet has nothing in Col G & H, but thanks for the teaching moment as to how it works. I'll copy the your Data sheet and put in my workbook tomorrow.

[bknight]

Still didn't work. The Data page is not updating.
I just reopened the workbook and instead of 6 Nov numbers(incorrectly), the Data page has 14 Nov numbers(correctly) but as you can see the numbers didn't transfer correctly into the correct cells.
The bottom image is after the code ran. The top image is after the workbook was reopened.


For tomorrow I commented the following lines. At the beginning of the code
'Application.EnableEvents = False
'Application.ScreenUpdating = False
'Application.Calculation = xlManual
I don't really understand what is going on.

[Rudi]

Would it be possible to send me your workbook? It'll make it so much easier to just work on your actual file!

*(If a zipped version of your file is too big to upload into the thread then send me a PM and I'll reply with an email address you can sent it to.)

TX

[bknight]

You have mail X2.

[Rudi]

Will respond...