Download multiple end of day data into Excel

BascherPA

New Member
Joined
May 3, 2020
Messages
23
Office Version
  1. 2010
Platform
  1. Windows
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.

VBA Code:
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
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.

John_w

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,810
Welcome to MrExcel forums.

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

BascherPA

New Member
Joined
May 3, 2020
Messages
23
Office Version
  1. 2010
Platform
  1. Windows
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

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,810
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

New Member
Joined
May 3, 2020
Messages
23
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

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

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,810
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

New Member
Joined
May 3, 2020
Messages
23
Office Version
  1. 2010
Platform
  1. Windows

ADVERTISEMENT

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

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,810
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.

VBA Code:
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

New Member
Joined
May 3, 2020
Messages
23
Office Version
  1. 2010
Platform
  1. Windows
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

MrExcel MVP
Joined
Oct 15, 2007
Messages
6,810
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,132,703
Messages
5,654,823
Members
418,155
Latest member
demasisi

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top