Stock data downloader makes excel 2010 non-responsive when I use 100+ tickers

[bicerg]

Hi,

I modified a macro I found online (link: Multiple Stock Quote Downloader for Excel) to download US historical stock data for 2 any two consecutive business days, but whenever I increase the number of companies to 100 or above excel becomes non-responsive. The code is as follows:

Sub DownloadStockQuotes(ByVal stockTicker As String, ByVal StartDate As Date, ByVal EndDate As Date, ByVal DestinationCell As String, ByVal freq As String)


Dim qurl As String
Dim StartMonth, StartDay, StartYear, EndMonth, EndDay, EndYear As String
Dim Monday As Integer
    
'Go back to friday for Previous Close data if the first day is a Monday
If Weekday(StartDate) = 2 Then
    Monday = "3"
End If



StartMonth = Format(Month(StartDate) - 1, "00")
StartDay = Format(Day(StartDate) - Monday, "00")
StartYear = Format(Year(StartDate), "00")


EndMonth = Format(Month(StartDate) - 1, "00")
EndDay = Format(Day(StartDate) + 4, "00")
EndYear = Format(Year(StartDate), "00")
qurl = "URL;http://table.finance.yahoo.com/table.csv?s=" + stockTicker + "&a=" + StartMonth + "&b=" + StartDay + "&c=" + StartYear + "&d=" + EndMonth + "&e=" + EndDay + "&f=" + EndYear + "&g=" + freq + "&ignore=.csv"


On Error GoTo ErrorHandler:
With ActiveSheet.QueryTables.Add(Connection:=qurl, Destination:=Range(DestinationCell))
    .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 = "20"
    .WebPreFormattedTextToColumns = True
    .WebConsecutiveDelimitersAsOne = True
    .WebSingleBlockTextImport = False
    .WebDisableDateRecognition = False
    .WebDisableRedirections = False
    .Refresh BackgroundQuery:=False
End With
ErrorHandler:


End Sub

Sub DownloadData()
Dim frequency As String
Dim numRows As Integer
Dim lastRow As Integer
Dim stockTicker As String


Application.ScreenUpdating = False


lastRow = ActiveSheet.Cells(Rows.Count, "a").End(xlUp).Row
frequency = Worksheets("Parameters").Range("b7")


'Loop through all tickers
For ticker = 11 To lastRow


    stockTicker = Worksheets("Parameters").Range("$a$" & ticker)


    If stockTicker = "" Then
        GoTo NextIteration
    End If


    Sheets.Add After:=Sheets(Sheets.Count)
    ActiveSheet.Name = stockTicker


    Call DownloadStockQuotes(stockTicker, Worksheets("Parameters").Range("$b$5"), Worksheets("Parameters").Range("$b$6"), "$a$2", frequency)
    Columns("a:a").TextToColumns Destination:=Range("a1"), DataType:=xlDelimited, _
                                 TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
                                 Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))
    Sheets(stockTicker).Columns("A:G").ColumnWidth = 10


    lastRow = Sheets(stockTicker).UsedRange.Row - 2 + Sheets(stockTicker).UsedRange.Rows.Count
    If lastRow < 3 Then
        Application.DisplayAlerts = False
        Sheets(stockTicker).Delete
        GoTo NextIteration
        Application.DisplayAlerts = True
    End If


    Sheets(stockTicker).Sort.SortFields.Add Key:=Range("A3:A" & lastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With Sheets(stockTicker).Sort
        .SetRange Range("A2:G" & lastRow)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
On Error Resume Next


'Copy previous close, 1st day data, 2nd day data


Sheets(stockTicker).Range("E3").Copy Sheets("Parameters").Range("B11").Offset(ticker - 11, 0)
Sheets(stockTicker).Range("B4:E4").Copy Sheets("Parameters").Range("C11").Offset(ticker - 11, 0)
Sheets(stockTicker).Range("B5:E5").Copy Sheets("Parameters").Range("G11").Offset(ticker - 11, 0)


Application.DisplayAlerts = False
Sheets(stockTicker).Delete
Application.DisplayAlerts = True


NextIteration:
Next ticker


'Delete all worksheets except parameters
Dim ws As Worksheet
Application.DisplayAlerts = False
For Each ws In Worksheets
    If ws.Name <> "Parameters" Then ws.Delete
Next
Application.DisplayAlerts = True


ErrorHandler:


Worksheets("Parameters").Select
Application.ScreenUpdating = True


End Sub

In plain English, the macro gets historical stock data using Yahoo finance from the day before the start date to the day after it, copies it into a new sheet named after the ticker symbol and arranges it chronologically. It then copies the price data into the main worksheet to the same row as the corresponding ticker, and deletes the ticker sheet.

It works fine as long as I don't give it too many ticker symbols, so I'm not very sure what the problem is, but I'm new to VBA and know no programming so I'm pretty sure I'm overlooking something. Any ideas?