VBA несколько веб-запросов зависает даже после очистки кэша

Question

Не могу найти решение нигде. Я загружаю данные об акциях примерно для 500 акций с помощью веб-запроса. В конечном итоге он зависнет, прежде чем загрузит весь список акций, и мне придется завершить процесс. Это работает, если я разобью список на 3 отдельные части. Я возился с частотой очистки кеша, но это не решило проблему. Любая помощь будет принята с благодарностью!

Private Sub Download_Click()
Dim i As Long, j As Long, STEnd As Long, STArray As Variant, TempSht As String, ST As String, SH As Worksheet
Dim symbols As String, sline As String, Values As Variant
Dim W As Worksheet: Set W = ActiveSheet
Dim ResearchSht As Worksheet: Set ResearchSht = ThisWorkbook.Sheets("Research")
Dim Last As Long

   Application.DisplayAlerts = False
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculateManual

TempSht = "Template"

'Delete Old Sheets
For Each SH In ThisWorkbook.Sheets
Select Case SH.Name
    Case ResearchSht.Name, "Template", "Trades"
    Case Else
        SH.Delete
End Select
Next

Last = ResearchSht.Cells(Rows.Count, 1).End(xlUp).Row
If Last = 1 Then Exit Sub
For j = 2 To Last
    ST = UCase(Trim(ResearchSht.Cells(j, 1)))
    ResearchSht.Cells(j, 1) = ST
    Worksheets.Add.Name = ST
    Select Case ST
        Case "^GSPC"
            SD = Day(Now)
            SM = Month(Now) - 1
            SY = Year(Now) - 10
            SY_2 = Year(Now)
        Case Else
            Check_Date
    End Select

    With ActiveSheet.QueryTables.Add(Connection:="URL;http://ichart.finance.yahoo.com/table.csv?s=" & ST & "&d=" & SM & "&e=" & SD & "&f=" & SY_2 & "&g=d&a=" & SM & "&b=" & SD & "&c=" & SY, Destination:=Sheets(ST).Range("$A$1"))
        .Name = ST
        .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 = "1,2"
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With

    'Split CSV data into columns
    STEnd = Sheets(ST).Range("A" & Rows.Count).End(xlUp).Row
    For i = 1 To STEnd - 1
        STArray = Split(Sheets(ST).Cells(i, 1), ",")
        Sheets(ST).Cells(i, 1).Value = STArray(0)
        Sheets(ST).Cells(i, 2).Value = STArray(1)
        Sheets(ST).Cells(i, 3).Value = STArray(2)
        Sheets(ST).Cells(i, 4).Value = STArray(3)
        Sheets(ST).Cells(i, 5).Value = STArray(4)
        Sheets(ST).Cells(i, 6).Value = STArray(5)
        Sheets(ST).Cells(i, 7).Value = STArray(6)
    Next
    Sheets(TempSht).Range("H:AU").Copy Destination:=Sheets(ST).Range("H1")
    Application.Calculation = xlCalculationAutomatic
    Sheets(ST).Range("H:AL").Copy
    Sheets(ST).Range("H1").PasteSpecial Paste:=xlValues
    Application.Calculation = xlCalculateManual
    Sheets(ST).Cells.EntireColumn.AutoFit
    ActiveSheet.Visible = xlSheetHidden

  Select Case j
      Case 10, 20, 30, 40, 50, 60, 70, 80, 90, 100, 110, 120, 130, 140, 150, 160, 170, 180, 190, 200, 210, 220, 230, 240, 250, 260, 270, 280, 290, 300, 310, 320, 330, 340, 350, 360, 370, 380, 390, 400, 410, 420, 430, 440, 450, 460, 470, 480, 490, 500, 510, 520, 530, 540, 550, 560, 570, 580, 590, 600, 610, 620, 630, 640, 650, 660, 670, 680, 690, 700, 710, 720, 730, 740, 750, 760, 770, 780, 790, 800, 810, 820, 830, 840, 850, 860, 870, 880, 890, 900, 910, 920, 930, 940, 950, 960, 970, 980, 990, 1000, 1010
          Shell "RunDll32.exe InetCpl.Cpl,ClearMyTracksByProcess 8"
  End Select
  'If ST <> "^GSPC" Then Sheets(ST).Delete 'Test
Next

ResearchSht.Activate
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True