Hi all. I've got a procedure I'm working on that loops through a list of stock symbols (strings) on one worksheet and uses them to concatenate a web address for a query table that is added to a different worksheet. I get an error for some of the symbols as it loops but it appears to be random. I know the address exists (I have error handling for ones that don't) and on one run some of the data will come in, on the next, the same values won't. The 1004 error says to check that the file exists. Any ideas? Server side issue? The code is below. Thanks in advance...
Code:
Sub PreEarningsOptions()
'Tracks the options activity for the front month of stocks with upcoming earnings. Checks my "revised put/ call ratio
'(the open interest in the front month calls that are at the money and above, and the open interest in the front month
'puts that are at the money and below.
'Create and name the workspace worksheet.
'Sort the earnings worksheet by date of interest.
'Find the beginning of the range to process.
'Loop through the range, copying to an array all symbols and date of interest.
'Loop through the array, writing the connect string and downloading data to the workspace.
'Loop through that data, running the formula(s) to get the key number(s).
'Copy the new row for that symbol to the PreEarningsOptions worksheet.
'Application.ScreenUpdating = False
Dim errorNumber As Integer 'Takes a value of 1 or 2 which is used to determine which branch decision
'in the error handler section to take.
Dim i As Integer 'The for/next loop counter for the loop that looks for the next month's
'options chain after the front month.
Dim QT As QueryTable 'The options query table(s).
Dim PCrat As Double 'The put/ call ratio of the active options chain.
Dim EAFinalRow As Long 'The final row of the earnings worksheet.
Dim EACurrentRow As Long 'The row being used to process each record in the earnings worksheet.
Dim PEONextRow As Long 'The variable to increment the row number for the "PreEarningsOptions" worksheet.
Dim connectString As String 'The string for the yahoo options page.
Dim currentSymbol As String 'The current symbol for the yahoo string.
Dim frontMonth As String 'The month value extracted from the front month option chain's expiration
'date string.
Dim nextMonth As String 'The next month integer that is used in the loop to find the next options
'chain after the front month.
Dim frontYear As String 'The year value extracted from the front month option chain's expiration
'date string.
Dim nextYear As Integer 'The next year integer that is used in the loop to find the next options
'chain after the front month.
Dim expDate As Date 'The date value of the expiration of the options chain being checked.
Dim dateOfInterest As Date 'The date value of the current row/ record's date of interest.
Set EA = Worksheets("Earnings")
Set PEO = Worksheets("PreEarningsOptions")
Set PEOW = Worksheets("PreEarnOptWksp")
'Sort the "earnings" worksheet by date of interest.
EA.ListObjects("EarningsTable").Sort. _
SortFields.Clear
EA.ListObjects("EarningsTable").Sort. _
SortFields.Add Key:=Range("EarningsTable[[#All],[Date Of Interest]]"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With EA.ListObjects("EarningsTable").Sort
.header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Find the final row of the earnings worksheet.
EAFinalRow = FinalRowFunct("Earnings", 1)
'If there is no data in the earnings worksheet, then exit with a message.
If EAFinalRow = 1 Then
MsgBox ("There is no data on the worksheet.")
Exit Sub
End If
'Find the start of the range to be processed.
EACurrentRow = 2
Do While (EACurrentRow <= EAFinalRow) And (EA.Cells(EACurrentRow, 6).Value < Date)
EACurrentRow = EACurrentRow + 1
Loop
'Now that we have the start row, loop through the remaining worksheet rows, getting the front month
'put/ call ratio on each row's symbol. The ratio, as well as the data to be copied over from the
'earnings worksheet, is loaded into an array. When the loop through the worksheet is done, the array
'is dumped onto the worksheet "PreEarningsOptions".
'Find the first (starting point) next row of the "PreEarningsOptions" worksheet.
PEONextRow = FinalRowFunct("PreEarningsOptions", 1) + 1
Continue1:
Do While EA.Cells(EACurrentRow, 6).Value <> ""
'Clear the entire workspace's cells.
PEOW.Cells.Clear
'Set the error number to 1. An error at this value likely means there are no options available.
'This is handled by skipping over the row from the "Earings" worksheet.
errorNumber = 1
'On Error GoTo errorTrap
'Delete the query table(s) from the workspace.
For Each QT In PEOW.QueryTables
QT.Delete
Next QT
'Get the current row's stock symbol.
currentSymbol = EA.Cells(EACurrentRow, 2).Value
'Get the current row's date of interest.
dateOfInterest = EA.Cells(EACurrentRow, 6).Value
'Create the string for the front month options table.
connectString = "URL;http://finance.yahoo.com/q/op?s=" & currentSymbol
'Create the web table(s). This is where an error1 would be thrown. The handler then skips the row and
'continues with the loop.
Set QT = PEOW.QueryTables.Add(Connection:=connectString, Destination:=PEOW.Cells(1, 1))
With QT
.Name = "Options"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "11,14,16,19"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
'Refresh the query
QT.Refresh BackgroundQuery:=False
'This is where we check if there are options. If there aren't the worksheet contains
'"Get for Another Symbol:" in cell(1,1). So if we dont' have that condition, then
'continue to process.
If PEOW.Cells(1, 1).Value <> "Get for Another Symbol: " Then
'Get the expiration date of this front- month options chain.
expDate = Right(PEOW.Cells(1, 2), 12)
'Check to see if the expiration date is before the date of interest. If it is, we need to
'find the next month's chain. If it isn't, there is no conditional check for this, we just
'look out three months. If there aren't any within 3 months we don't download data.
If expDate < dateOfInterest Then
frontMonth = month(expDate)
frontYear = Year(expDate)
'Loop up three months from the front month, looking for the next options chain. If there
'isn't one in the next three months the row is ignored/ no data downloaded.
For i = 1 To 3
Continue2:
nextMonth = frontMonth + i
If nextMonth > 12 Then
nextMonth = nextMonth - 12
nextYear = frontYear + 1
Else
nextYear = frontYear
End If
'Add a "0" before the nextMonth integer if it's less than 10 for the correct connection
'string.
If nextMonth < 10 Then
nextMonth = "0" & nextMonth
End If
'Change the error number. If the error is thrown here, the (for i=1 to 3) inner loop
'iterates.
errorNumber = 2
'Write the connection string.
'http://finance.yahoo.com/q/op?s=RIMM&m=2009-06
connectString = "URL;http://finance.yahoo.com/q/op?s=" & currentSymbol & "&m=" & _
nextYear & "-" & nextMonth
'Try to get the next month's options chain.
'First, delete the query table(s) from the workspace.
For Each QT In PEOW.QueryTables
QT.Delete
Next QT
'Clear the entire workspace's cells.
PEOW.Cells.Clear
'Create the web table(s). This is where an error2 would be thrown.
Set QT = PEOW.QueryTables.Add(Connection:=connectString, Destination:=PEOW.Cells(1, 1))
With QT
.Name = "Options"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "11,14,16,19"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
'Refresh the query.
QT.Refresh BackgroundQuery:=False
'If there is no error before this line, a next-month options chain was found.
'We can exit the loop.
Exit For
Next i
End If
'Get the PCRatio from the function.
PCrat = PCratio("PreEarnOptWksp")
'Copy the desired values to the "PreEarningsOptions" worksheet.
PEO.Cells(PEONextRow, 1).Value = currentSymbol
PEO.Cells(PEONextRow, 2).Value = Date
PEO.Cells(PEONextRow, 3).Value = expDate
PEO.Cells(PEONextRow, 4).Value = PCrat
'Since there was a record returned, increment the next row counter for "PreEarningsOptions" worksheet.
PEONextRow = PEONextRow + 1
End If
'Increment EACurrentRow. This increments wether or not a record was returned for options for the
'symbol being checked.
EACurrentRow = EACurrentRow + 1
Loop
'Remove duplicates.
'Application.ScreenUpdating = True
Exit Sub
errorTrap:
If errorNumber = 1 Then
EACurrentRow = EACurrentRow + 1
Resume Continue1
Else
i = i + 1
Resume Continue2
End If
End Sub
Function PCratio(wksht) As Double
'Calculates the put/ call ratio for an options chain that is on a worksheet.
'Paramaters: Worksheet name.
Dim WKS As Worksheet
Dim i As Integer 'The loop increment variable.
Dim callsOpenInt As Long 'The open interest total for calls.
Dim putsOpenInt As Long 'The open interest total for puts.
Set WKS = Worksheets(wksht)
'Initialize the calls and puts variables to 0.
callsOpenInt = 0
putsOpenInt = 0
'Find the first row of the calls' open interest.
i = 1
Do While WKS.Cells(i, 8).Value = ""
i = i + 1
Loop
'Skip the line that has the header "open int."
i = i + 1
'Add the calls open interest.
Do While WKS.Cells(i, 8).Value <> ""
callsOpenInt = callsOpenInt + WKS.Cells(i, 8).Value
i = i + 1
Loop
'Find the first row of the puts' open interest.
Do While WKS.Cells(i, 8).Value = ""
i = i + 1
Loop
'Skip the line that has the header "open int."
i = i + 1
'Add the puts open interest.
Do While WKS.Cells(i, 8).Value <> ""
putsOpenInt = putsOpenInt + WKS.Cells(i, 8).Value
i = i + 1
Loop
PCratio = putsOpenInt / callsOpenInt
End Function
