Download multiple end of day data into Excel

[BascherPA]

Hello all,

I am glad to be here and post my first thread.

I want to load historical data from yahoo finance into excel via VBA.
Because this is only possible for one symbol in my code I want to enlarge this code to determine a list of symbols/stocks and download the end of day/week adjusted close prices into a cell.
Best solution would be if the downloaded price could be placed besides the cell of ticker form the list.
Unfortunately I am a novice in excel and do not know how to implement an array for such a list so I would be very pleased if somebody could tell me the correct code for this aim.

Sub Daten_aus_excel()


Range("A9:G5000").ClearContents

Dim ticker As String
ticker = Range("B4")


    With ActiveSheet.QueryTables.Add(Connection:= _
        "TEXT;https://www.alphavantage.co/query?function=TIME_SERIES_MONTHLY_ADJUSTED&symbol=" & ticker & "&apikey=demo&datatype=csv" _
        , Destination:=Range("$A$9"))
        .Name = _
        "query?function=TIME_SERIES_MONTHLY_ADJUSTED&symbol=" & ticker & "&apikey=demo&datatype=csv_1"
        
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = False
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = True
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(3, 9, 9, 9, 9, 1, 9, 9)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False
    End With
End Sub

Thank you in advance for your support.

Best regards
Benjamin

 

[John_w]

Welcome to MrExcel forums.

In which cells are the tickers and where do you want to place the imported data?

 

[BascherPA]

Hello John,

Thank you for your reply.
Ticker 1 is in Cell B4, Ticker 2 in Cell B5 etc.
Besides e.g. in cell C4 should be placed the value.

BR
Benjamin

 

[John_w]

But the query returns 2 columns (timestamp and adjusted close) and multiple rows. Which data should be placed in the cell next to the ticker?

 

[BascherPA]

The best solution would be as follows.
The code read a list of stocks (sysmbos e.g. APPL, MSFT... listed in the main spreadsheet e.g. B5 until B35).
For each stock/cell the loop will be execute andthe data will be placed in a new spreadsheet (named before as the stock e.g. spreadsheet APPL) in the first row, cell A1 timestamp and B1 value. The "old" data should be slipped down one row.

 

[John_w]

Okay, you've changed the output data destination, but you haven't answered my question. The query returns 240 rows (240 timestamps and 240 adjusted closes); which data should be placed in A1 and B1? The most recent timestamp and data value?

 

[BascherPA]

Sorry John, A1 would be "Date" and B1 "Value" which is fix.
Below zu in A2 should be the newest timestamp and in B2 there should be the value. Below this second row there should be the other rows which only will be executes once and afterwards only the current date and value should be added in row 2.

BR
Benjamin

 

[John_w]

See if this macro does what you want. You need a workbook with 1 sheet named "Symbols" with the symbols in column A starting at A2. The macro adds or updates the sheet for each symbol as needed.

Option Explicit


Const APIkey = "demo"


Public Sub Import_All_Symbols()

    Dim symbolCell As Range
    Dim tempSheet As Worksheet
    
    With ThisWorkbook
        Set tempSheet = .Worksheets.Add(after:=.Worksheets(.Worksheets.Count))
    End With
    
    With ThisWorkbook.Worksheets("Symbols")
        For Each symbolCell In .Range("A2", .Cells(.Rows.Count, "A").End(xlUp))
            Import_Symbol_Data symbolCell.Value, tempSheet
        Next
    End With
    
    Application.DisplayAlerts = False
    tempSheet.Delete
    Application.DisplayAlerts = True
    
End Sub


Private Sub Import_Symbol_Data(symbol As String, tempSheet As Worksheet)

    Dim symbolSheet As Worksheet
    Dim copyAllRows As Boolean
    Dim QT As QueryTable
    
    copyAllRows = False
    With ThisWorkbook
        On Error Resume Next
        Set symbolSheet = .Worksheets(symbol)
        On Error GoTo 0
        If symbolSheet Is Nothing Then
            Set symbolSheet = .Worksheets.Add(after:=.Worksheets(.Worksheets.Count))
            symbolSheet.Name = symbol
            symbolSheet.Range("A1:B1").Value = Array("Date", "Adjusted Close")
            copyAllRows = True
        End If
    End With
    
    With tempSheet
        Set QT = .QueryTables.Add(Connection:="TEXT;https://www.alphavantage.co/query?function=TIME_SERIES_MONTHLY_ADJUSTED&symbol=" & symbol & "&apikey=" & APIkey & "&datatype=csv", _
                                  Destination:=.Range("A1"))
        With QT
            .Name = "web_query"
            .FieldNames = True
            .RowNumbers = False
            .FillAdjacentFormulas = False
            .PreserveFormatting = True
            .RefreshOnFileOpen = False
            .RefreshStyle = xlInsertDeleteCells
            .SavePassword = False
            .SaveData = True
            .AdjustColumnWidth = True
            .RefreshPeriod = 0
            .TextFilePromptOnRefresh = False
            .TextFilePlatform = 850
            .TextFileStartRow = 1
            .TextFileParseType = xlDelimited
            .TextFileTextQualifier = xlTextQualifierDoubleQuote
            .TextFileConsecutiveDelimiter = False
            .TextFileTabDelimiter = False
            .TextFileSemicolonDelimiter = False
            .TextFileCommaDelimiter = True
            .TextFileSpaceDelimiter = False
            .TextFileColumnDataTypes = Array(3, 9, 9, 9, 9, 1, 9, 9)
            .TextFileTrailingMinusNumbers = True
            .Refresh BackgroundQuery:=False
            If copyAllRows Then
                symbolSheet.Range("A2:B2").Resize(.ResultRange.Rows.Count - 1).Value = .ResultRange.Offset(1).Value
            Else
                symbolSheet.Rows(2).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                symbolSheet.Range("A2:B2").Value = tempSheet.Range("A2:B2").Value
            End If
            .Delete
        End With
                
    End With
    
End Sub

 

[BascherPA]

Hello John,

thanks a lot for your suggestion.
There will be created the worksheets according to the listed symbols with the appropriate data but there also will be created an addition worksheet with all the symbol data summed up.
Is it possible to avoid that?

BR
Benjamin

 

[John_w]

I don't understand you. The macro doesn't create a "worksheet with all the symbol data summed up", so there is nothing to avoid.

For each symbol, the macro:

• Either - Creates a sheet for that symbol, if that sheet doesn't exist, and copies all the data rows into it.
• Or - Updates the sheet for that symbol by copying only the latest data row into it.