VBA help - yahoo finance downloader

vishu

Board Regular
Joined
Oct 26, 2011
Messages
70
Office Version
  1. 2016
Platform
  1. Windows
Please help me i used this code from net but when i click download data neither giving error nor data

VBA Code:
Sub GetData()

    Dim QuerySheet As Worksheet
    Dim DataSheet As Worksheet
    Dim Symbol As String
    Dim startDate As String
    Dim endDate As String
    Dim period As String
    Dim last As Double
    Dim OffsetCounter As Double
    Dim crumb As String
    Dim cookie As String
    Dim validCookieCrumb As Boolean

    Dim qurl As String
    Dim nQuery As Name
    Dim i As Integer, N As Integer, pct As Double
  

    Application.ScreenUpdating = True
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationAutomatic
  
    Set QuerySheet = Sheets("Download")
    Set DataSheet = Sheets("Calculations")

    N = Range("C1")

    Clear                           ' clear old data
    Init                            ' paste headings
' ----------------------------------

For i = 1 To N
  
    Range("A1") = i
    Range("B4") = Cells(i + 7, 1)  ' get symbol
    Cells(i + 7, 1).Select
     
   Application.ScreenUpdating = False
 
    Range("K5:AE5").Select           ' collect calculations
    Selection.Copy
     
    Sheets("Calculations").Select      ' move to Calculations sheet
    Cells(i + 7, 3).Select          ' select proper row and paste calculations
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Sheets("Download").Select           ' move to Data sheet
  
    Application.ScreenUpdating = True
  
Next i

    Range("A1").Select
    Selection.ClearContents

    Sheets("Calculations").Select
    GetNames
    Formats
    Range("C1").Select
 
        startDate = DataSheet.Range("B2").Value
        endDate = DataSheet.Range("B3").Value
        Symbol = DataSheet.Range("B4").Value
        Range("C7").CurrentRegion.ClearContents
      
         period = "1d"
  
    ' Period
    If QuerySheet.Range("B3") = "Daily" Then
        period = "1d"
    ElseIf QuerySheet.Range("B3") = "Weekly" Then
        period = "1wk"
    ElseIf QuerySheet.Range("B3") = "Monthly" Then
        period = "1mo"
    End If
      
    Call getCookieCrumb(crumb, cookie, validCookieCrumb)
    DataSheet.Range("A8:HI600").ClearContents
  
    'Loop over multiple symbols
    For i = 8 To last
    Symbol = QuerySheet.Range("A" & i).Value
    OffsetCounter = 1
    Call ExtractData(Symbol, startDate, endDate, period, cookie, crumb, OffsetCounter)
    Next i

    DataSheet.Columns("A:H").AutoFit
  
    Application.Calculation = xlCalculationAutomatic
    QuerySheet.Select
  
End Sub

Sub getCookieCrumb(crumb As String, cookie As String, validCookieCrumb As Boolean)
 
    Dim i As Integer
    Dim str As String
    Dim crumbStartPos As Long
    Dim crumbEndPos As Long
    Dim objRequest
 
    validCookieCrumb = False
  
    For i = 0 To 5
        Set objRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
        With objRequest
            .Open "GET", "[URL='https://finance.yahoo.com/lookup?s=bananas']Symbol Lookup from Yahoo Finance[/URL]", False
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
            .send
            .waitForResponse (10)
           ' cookie = Split(.getResponseHeader("Set-Cookie"), ";")(0)
            crumbStartPos = InStrRev(.ResponseText, """crumb"":""") + 9
            crumbEndPos = crumbStartPos + 11
            crumb = Mid(.ResponseText, crumbStartPos, crumbEndPos - crumbStartPos)
        End With
      
        If Len(crumb) = 11 Then
            validCookieCrumb = True
            Exit For
        End If:
      
    Next i
  
'turn calculation back on

    Application.DisplayAlerts = True
    Range("C8:I600").Select
    Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
      
    RemoveNames
Range("A1").Select
End Sub
Sub ExtractData(Symbols As String, startDate As String, endDate As String, period As String, cookie As String, crumb As String, OffsetCounter As Double)

    Dim resultFromYahoo As String
    Dim objRequest
    Dim csv_rows() As String
    Dim resultArray As Variant
    Dim nColumns As Integer
    Dim iRows As Integer
    Dim CSV_Fields As Variant
    Dim iCols As Integer
    Dim tickerURL As String

    tickerURL = "[URL]https://query1.finance.yahoo.com/v7/finance/download/[/URL]" & Symbols & _
        "?period1=" & startDate & _
        "&period2=" & endDate & _
        "&interval=" & period & "&events=history" & "&crumb=" & crumb
             
    Set objRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
    With objRequest
        .Open "GET", tickerURL, False
'        .setRequestHeader "Cookie", cookie
        .send
        .waitForResponse
        resultFromYahoo = .ResponseText
    End With
    End Sub
  
Sub RemoveNames()

Dim nQuery As Name

        For Each nQuery In Names
            If IsNumeric(Right(nQuery.Name, 1)) Then
                nQuery.Delete
            End If
        Next nQuery

End Sub

Sub Clear()
'
' Clear Macro
' Macro recorded 8/13/2006 by Ponzo

    Sheets("Calculations").Select  ' move to Calculations sheet
  
    Range("A8:AE600").Select     ' CLEAR OLD STUFF
    Selection.ClearContents
    Formats
    Sheets("Download").Select      ' move back
  
End Sub
Sub Move()
'
' Move Macro
' Macro recorded 09/03/2007 by pjPonzo
'

    Range("C7:C600").Select
    Selection.Copy
    Range("K7").Select
    ActiveSheet.Paste
  
    Range("I7:I600").Select
    Selection.Copy
    Range("L7").Select
    ActiveSheet.Paste

End Sub
Sub Init()
'
' Init Macro
' Macro recorded 09/03/2007 by pjPonzo
'

'
    Range("K3:AE4").Select
    Selection.Copy
    Sheets("Calculations").Select
    Range("C5").Select
    ActiveSheet.Paste
    Sheets("Download").Select
End Sub

Sub GetNames()

    Dim QuerySheet As Worksheet
    Dim DataSheet As Worksheet
    Dim qurl As String
    Dim i As Integer
  
    Sheets("Calculations").Select
  
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
  
'    Set DataSheet = ActiveSheet
 
    Range("A8").CurrentRegion.ClearContents

                      
  
'turn calculation back on
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True

    Columns("A:A").Select
    Selection.ColumnWidth = 20
  
End Sub

Sub Formats()
'
' Formats Macro
' Macro recorded 9/5/2008 by pjPonzo
'

'
    Range("D8:Z8").Select
    Selection.Copy
    Range("D9:Z600").Select
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
      
    Range("A1").Select
    Selection.ClearContents
  
End Sub
 

Attachments

  • 1.jpg
    1.jpg
    242.7 KB · Views: 57
Last edited by a moderator:

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
Can't help with code. Not in my wheel house. Good Luck.
The following statement does not help me to help you. What didn't work? The Link I provided will work for you if you are running O365 or XL2021. You have not provided what version of Excel you are using. Perhaps if you update your profile then we might be able to better assist.

But file is not working for me.
 
Upvote 0
Please help me i used this code from net but when i click download data neither giving error nor data

VBA Code:
Sub GetData()

    Dim QuerySheet As Worksheet
    Dim DataSheet As Worksheet
    Dim Symbol As String
    Dim startDate As String
    Dim endDate As String
    Dim period As String
    Dim last As Double
    Dim OffsetCounter As Double
    Dim crumb As String
    Dim cookie As String
    Dim validCookieCrumb As Boolean

    Dim qurl As String
    Dim nQuery As Name
    Dim i As Integer, N As Integer, pct As Double
 

    Application.ScreenUpdating = True
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationAutomatic
 
    Set QuerySheet = Sheets("Download")
    Set DataSheet = Sheets("Calculations")

    N = Range("C1")

    Clear                           ' clear old data
    Init                            ' paste headings
' ----------------------------------

For i = 1 To N
 
    Range("A1") = i
    Range("B4") = Cells(i + 7, 1)  ' get symbol
    Cells(i + 7, 1).Select
    
   Application.ScreenUpdating = False
 
    Range("K5:AE5").Select           ' collect calculations
    Selection.Copy
    
    Sheets("Calculations").Select      ' move to Calculations sheet
    Cells(i + 7, 3).Select          ' select proper row and paste calculations
    Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
    Sheets("Download").Select           ' move to Data sheet
 
    Application.ScreenUpdating = True
 
Next i

    Range("A1").Select
    Selection.ClearContents

    Sheets("Calculations").Select
    GetNames
    Formats
    Range("C1").Select
 
        startDate = DataSheet.Range("B2").Value
        endDate = DataSheet.Range("B3").Value
        Symbol = DataSheet.Range("B4").Value
        Range("C7").CurrentRegion.ClearContents
     
         period = "1d"
 
    ' Period
    If QuerySheet.Range("B3") = "Daily" Then
        period = "1d"
    ElseIf QuerySheet.Range("B3") = "Weekly" Then
        period = "1wk"
    ElseIf QuerySheet.Range("B3") = "Monthly" Then
        period = "1mo"
    End If
     
    Call getCookieCrumb(crumb, cookie, validCookieCrumb)
    DataSheet.Range("A8:HI600").ClearContents
 
    'Loop over multiple symbols
    For i = 8 To last
    Symbol = QuerySheet.Range("A" & i).Value
    OffsetCounter = 1
    Call ExtractData(Symbol, startDate, endDate, period, cookie, crumb, OffsetCounter)
    Next i

    DataSheet.Columns("A:H").AutoFit
 
    Application.Calculation = xlCalculationAutomatic
    QuerySheet.Select
 
End Sub

Sub getCookieCrumb(crumb As String, cookie As String, validCookieCrumb As Boolean)
 
    Dim i As Integer
    Dim str As String
    Dim crumbStartPos As Long
    Dim crumbEndPos As Long
    Dim objRequest
 
    validCookieCrumb = False
 
    For i = 0 To 5
        Set objRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
        With objRequest
            .Open "GET", "[URL='https://finance.yahoo.com/lookup?s=bananas']Symbol Lookup from Yahoo Finance[/URL]", False
            .setRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
            .send
            .waitForResponse (10)
           ' cookie = Split(.getResponseHeader("Set-Cookie"), ";")(0)
            crumbStartPos = InStrRev(.ResponseText, """crumb"":""") + 9
            crumbEndPos = crumbStartPos + 11
            crumb = Mid(.ResponseText, crumbStartPos, crumbEndPos - crumbStartPos)
        End With
     
        If Len(crumb) = 11 Then
            validCookieCrumb = True
            Exit For
        End If:
     
    Next i
 
'turn calculation back on

    Application.DisplayAlerts = True
    Range("C8:I600").Select
    Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
     
    RemoveNames
Range("A1").Select
End Sub
Sub ExtractData(Symbols As String, startDate As String, endDate As String, period As String, cookie As String, crumb As String, OffsetCounter As Double)

    Dim resultFromYahoo As String
    Dim objRequest
    Dim csv_rows() As String
    Dim resultArray As Variant
    Dim nColumns As Integer
    Dim iRows As Integer
    Dim CSV_Fields As Variant
    Dim iCols As Integer
    Dim tickerURL As String

    tickerURL = "[URL]https://query1.finance.yahoo.com/v7/finance/download/[/URL]" & Symbols & _
        "?period1=" & startDate & _
        "&period2=" & endDate & _
        "&interval=" & period & "&events=history" & "&crumb=" & crumb
            
    Set objRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
    With objRequest
        .Open "GET", tickerURL, False
'        .setRequestHeader "Cookie", cookie
        .send
        .waitForResponse
        resultFromYahoo = .ResponseText
    End With
    End Sub
 
Sub RemoveNames()

Dim nQuery As Name

        For Each nQuery In Names
            If IsNumeric(Right(nQuery.Name, 1)) Then
                nQuery.Delete
            End If
        Next nQuery

End Sub

Sub Clear()
'
' Clear Macro
' Macro recorded 8/13/2006 by Ponzo

    Sheets("Calculations").Select  ' move to Calculations sheet
 
    Range("A8:AE600").Select     ' CLEAR OLD STUFF
    Selection.ClearContents
    Formats
    Sheets("Download").Select      ' move back
 
End Sub
Sub Move()
'
' Move Macro
' Macro recorded 09/03/2007 by pjPonzo
'

    Range("C7:C600").Select
    Selection.Copy
    Range("K7").Select
    ActiveSheet.Paste
 
    Range("I7:I600").Select
    Selection.Copy
    Range("L7").Select
    ActiveSheet.Paste

End Sub
Sub Init()
'
' Init Macro
' Macro recorded 09/03/2007 by pjPonzo
'

'
    Range("K3:AE4").Select
    Selection.Copy
    Sheets("Calculations").Select
    Range("C5").Select
    ActiveSheet.Paste
    Sheets("Download").Select
End Sub

Sub GetNames()

    Dim QuerySheet As Worksheet
    Dim DataSheet As Worksheet
    Dim qurl As String
    Dim i As Integer
 
    Sheets("Calculations").Select
 
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
 
'    Set DataSheet = ActiveSheet
 
    Range("A8").CurrentRegion.ClearContents

                     
 
'turn calculation back on
    Application.Calculation = xlCalculationAutomatic
    Application.DisplayAlerts = True

    Columns("A:A").Select
    Selection.ColumnWidth = 20
 
End Sub

Sub Formats()
'
' Formats Macro
' Macro recorded 9/5/2008 by pjPonzo
'

'
    Range("D8:Z8").Select
    Selection.Copy
    Range("D9:Z600").Select
    Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=False
     
    Range("A1").Select
    Selection.ClearContents
 
End Sub

Where did you find this code?
 
Upvote 0
Upvote 0
Can't help with code. Not in my wheel house. Good Luck.
The following statement does not help me to help you. What didn't work? The Link I provided will work for you if you are running O365 or XL2021. You have not provided what version of Excel you are using. Perhaps if you update your profile then we might be able to better assist.
Ohh sorry my excel version is Office Home 2016. And thank you for the help
 
Upvote 0
my excel version is Office Home 2016

I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)
 
Upvote 0
I suggest that you update your Account details (or click your user name at the top right of the forum) so helpers always know what Excel version(s) & platform(s) you are using as the best solution often varies by version. (Don’t forget to scroll down & ‘Save’)
Thank you sir
 
Upvote 0
I looked at the file from post #8.

It appears to create a link of something like:
Rich (BB code):
https://query1.finance.yahoo.com/v7/finance/download/%5ENSEI?period1=6/19/2021&period2=6/9/2022&interval=1d&events=history&crumb=agORxV\u002

The actual link when manually going to the website creates a link like:
Rich (BB code):
https://query1.finance.yahoo.com/v7/finance/download/%5ENSEI?period1=1623267647&period2=1654803647&interval=1d&events=history&includeAdjustedClose=true

How you will get those 2 numbers used for period1 & period2 I am not sure.
 
Upvote 0
I looked at the file from post #8.

It appears to create a link of something like:
Rich (BB code):
https://query1.finance.yahoo.com/v7/finance/download/%5ENSEI?period1=6/19/2021&period2=6/9/2022&interval=1d&events=history&crumb=agORxV\u002

The actual link when manually going to the website creates a link like:
Rich (BB code):
https://query1.finance.yahoo.com/v7/finance/download/%5ENSEI?period1=1623267647&period2=1654803647&interval=1d&events=history&includeAdjustedClose=true

How you will get those 2 numbers used for period1 & period2 I am not sure.
Actually am not a programmer I thought if I merge two file code... Tried but no success. Sincerely appreciate your efforts
 
Upvote 0
I have an idea, but this is not exactly my 'wheelhouse' so to speak, so it might take me a bit.
 
Upvote 0

Forum statistics

Threads
1,223,231
Messages
6,170,884
Members
452,364
Latest member
springate

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
Back
Top