The program downloads stock information from Yahoo! Finance and displays it in the spreadsheet. On my Mac the program takes 10 minutes to get data for approximately 4000 stocks and on the PC it takes 45 minutes. I wrote another version which copies and pastes the data instead of iterating through each price value, but every time I run that macro, the runtime increases. That version takes about 15 minutes on a PC and 45 minutes on a Mac.
I don't know what is going on but I just want a program that runs in < 15 minutes on both operating systems and has a consistent runtime.
Option Explicit
Sub GetData()
Application.Calculation = xlCalculationManual
Dim numb_tickers As Integer
numb_tickers = Application.WorksheetFunction.CountBlank(Worksheets("Sheet1").Range(Sheet1.Cells(2, 2), Sheet1.Cells(5000, 2)))
numb_tickers = 5000 - numb_tickers
Dim start_ticker As Integer
start_ticker = Sheet3.Cells(5, 2) + 1
Dim end_ticker As Integer
end_ticker = Sheet3.Cells(6, 2) + 1
Dim x As Integer
For x = start_ticker To end_ticker
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
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Data").Cells.Clear
Set DataSheet = ActiveSheet
StartDate = Sheet3.Cells(2, 2)
EndDate = Sheet3.Cells(3, 2)
Symbol = Sheet1.Cells(x, 2)
Sheets("Data").Range("a1").CurrentRegion.ClearContents
qurl = "http://ichart.finance.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=" & Sheets("Data").Range("a1") & "&q=q&y=0&z=" & _
Symbol & "&x=.csv"
QueryQuote:
With Sheets("Data").QueryTables.Add(Connection:="URL;" & qurl, Destination:=Sheets("Data").Range("a1"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
On Error GoTo ErrorHandler
.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
Dim numb_days As Integer
numb_days = Application.WorksheetFunction.CountBlank(Worksheets("Data").Range(Sheet2.Cells(2, 7), Sheet2.Cells(1000, 7)))
numb_days = 1000 - numb_days
Dim z As Integer
For z = 2 To numb_days + 1
Worksheets("Sheet1").Cells(x, z + 5) = Worksheets("Data").Cells(z, 7)
Next z
ErrorHandler: Resume Next
Next x
Dim xyz As Integer
For xyz = 2 To numb_days + 1
Worksheets("Sheet1").Cells(1, xyz + 5) = Worksheets("Data").Cells(xyz, 1)
Next xyz
Application.Calculation = xlCalculationAutomatic
End Sub
Workbooks.Open()
and passing in the URL as the filename. \$\endgroup\$