Pulling CSV from ichart Yahoo Finance within Loop, but cant run more than 25 symbols

[Stillbillieve]

I'm using the following VBA to pull historical stock prices from Yahoo finance using there ichart/csv link url. I then create formuals to calculate the difference between the 20/50day moving average, which is then is linked to a chart. A screen shot is taken of the chart and then saved as a jpeg. All of that code is on a loop that reads a list of ticker symbols. The code runs without issue most of the time, unless yahoo does not have a ticker and it breaks. The thing that I can understand is that I can't run more than 20-25 symbols without getting a Run-Time error '1004': Application-defined or object-defined error. When I debug, it takes me to the following line:

-->> Sheets("Data").Sort.SortFields.Add Key:=Range("A2:A" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

If I save the file and open it back up I can run another 20-25 symbols until the error appears again.

Can anyone help me understand what is happening?


Sub GetData()
Dim DataSheet As Worksheet
Dim EndDate As Date
Dim StartDate As Date
Dim Symbol As String
Dim qurl As String
Dim nQuery As Name
Dim LastRow As Integer
Dim pic_rng, RngToCover As Range
Dim ShTemp As Worksheet
Dim ChTemp As Chart
Dim PicTemp As Picture
Dim ChtOb As ChartObject
Dim Time As String
Dim i As Integer
Dim rName, cName As Name


Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

i = 11
Time = Sheets("Prospects").Range("B" & i).Value

Sheets("Data").Cells.Clear

Do While Time <> ""

Sheets("Prospects").Range("B6").Value = Time

Set DataSheet = ActiveSheet

StartDate = DataSheet.Range("startDate").Value
EndDate = DataSheet.Range("endDate").Value
Symbol = DataSheet.Range("ticker").Value
Sheets("Data").Range("a1").CurrentRegion.ClearContents

qurl = "http://ichart.yahoo.com/table.csv?s=" & Symbol
qurl = qurl & "&a=" & Month(StartDate) - 1 & "&b=" & Day(StartDate) & "&c=" & Year(StartDate) & " &d=" & Month(EndDate) - 1 & "&e=" & Day(EndDate) & "&f=" & Year(EndDate) & "&g=d&d=.csv"

QueryQuote:
With Sheets("Data").QueryTables.Add(Connection:="URL;" & qurl, Destination:=Sheets("Data").Range("a1"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With

Sheets("Data").Range("a1").CurrentRegion.TextToColumns Destination:=Sheets("Data").Range("a1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, other:=False

Sheets("Data").Columns("A:G").ColumnWidth = 12

LastRow = Sheets("Data").UsedRange.Row - 2 + Sheets("Data").UsedRange.Rows.Count

Sheets("Data").Sort.SortFields.Add Key:=Range("A2:A" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

'ADD 20/50 Moving Average Formulas
Sheets("Data").Select
Range("H1").Select
ActiveCell.FormulaR1C1 = "20-Day"
Range("H2").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(RC[-3]:R[19]C[-3])"
Range("I1").Select
ActiveCell.FormulaR1C1 = "50-Day"
Range("I2").Select
ActiveCell.FormulaR1C1 = "=AVERAGE(RC[-4]:R[49]C[-4])"
Range("J1").Select
ActiveCell.FormulaR1C1 = "20>50"
Range("J2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-2]>RC[-1],""True"",""False"")"
Range("K1").Select
ActiveCell.FormulaR1C1 = "20-50 Difference"
Range("K2").Select
ActiveCell.FormulaR1C1 = "=RC[-3]-RC[-2]"
Range("L1").Select
ActiveCell.FormulaR1C1 = "Direction"
Range("L2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-1]>R[1]C[-1],""Up"",""Down"")"
Range("H2:L2").Select
Selection.Copy
Range("H3:H210").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("N2").Select
ActiveCell.FormulaR1C1 = "Min"
Range("N2:N3").Select
Range("N3").Activate
ActiveCell.FormulaR1C1 = "Max"
Range("O2").Select
ActiveCell.FormulaR1C1 = "=ROUNDDOWN(MIN(RC[-10]:R[208]C[-10]),0)"
Range("O3").Select
ActiveCell.FormulaR1C1 = "=ROUNDUP(MAX(R[-1]C[-10]:R[207]C[-10]),0)"
Range("A1").Select
Calculate

'CHANGE MIN/MAX OF SECONDARY AXIS
With ActiveSheet.ChartObjects("Chart 1").Chart
With .Axes(xlValue, xlSecondary)
.MaximumScale = ActiveSheet.Range("O3").Value
.MinimumScale = ActiveSheet.Range("O2").Value
End With
End With

'SAVE SCREENSHOT
Set pic_rng = Worksheets("Data").Range("N5:AG43")
Set ShTemp = Worksheets.Add

Charts.Add
ActiveChart.Location Where:=xlLocationAsObject, Name:=ShTemp.Name

Set RngToCover = ActiveSheet.Range("A1:S35")
Set ChtOb = ActiveChart.Parent
ChtOb.Height = RngToCover.Height ' resize
ChtOb.Width = RngToCover.Width ' resize
ChtOb.Top = RngToCover.Top ' reposition
ChtOb.Left = RngToCover.Left ' reposition

Set ChTemp = ActiveChart
pic_rng.CopyPicture Appearance:=xlScreen, Format:=xlPicture
ChTemp.Paste

Set PicTemp = Selection

With ChTemp.Parent
.Width = PicTemp.Width
.Height = PicTemp.Height
End With

ChTemp.Export Filename:="C:\My Documents\Stocks\Screenshot - " & Symbol & ".jpg", FilterName:="jpg"

Application.DisplayAlerts = False
ShTemp.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True

ActiveWorkbook.Connections("Connection").Delete

For Each rName In ActiveWorkbook.Names
If rName.Name <> "endDate" And rName.Name <> "startDate" And rName.Name <> "ticker" Then
rName.Delete
End If
Next rName

i = i + 1
Sheets("Prospects").Select
Time = Sheets("Prospects").Range("B" & i).Value

Loop

MsgBox ("Update Complete")

End Sub

[sbehera]

Hi, I changed the bleow

Please Login or Register  to view this content.

to

Please Login or Register  to view this content.

and it worked fine...check once

[Stillbillieve]

Sometimes a second set of well trained eyes is all you need. Thanks!

[mike7952]

Heres another way, see what you think.

Will need to change the pic file output path

[sbehera]

Hi mike7952 , I cant say that I understand fully your code. but you did a AWESOME job... I want to learn this...do you have any reference where i can learn this, something like that....