Hello Everyone,
Please check BELOW VBA CODE. Really great work. Earlier i used to download multiple stock data through this file but now file code not working yahoo changed there links.
Someone please help me to work this file AND THIS IS MY FIRST THREAD SO EXCELFORUM NOT ALLOWING ME TO INSERT ANY LINK OR URL so have just mentioned in bold with colour "YAHOO OLD LINK"
Thanks you very much in advance
Sub GetData()
' thanks to Ron McEwan :^)
Dim QuerySheet As Worksheet
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 i As Integer, N As Integer, pct As Double
Application.DisplayAlerts = False
Application.Calculation = xlCalculationAutomatic
Set DataSheet = ActiveSheet
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
GetOne ' download one stock
UpdateScale ' update chart scale
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
End Sub
Sub GetOne()
' Download one stock only
Dim QuerySheet As Worksheet
Dim DataSheet As Worksheet
Dim EndDate As Date
Dim StartDate As Date
Dim Symbol As String
Dim qurl As String
Dim nQuery As Name
Application.ScreenUpdating = True
Application.DisplayAlerts = False
Application.Calculation = xlCalculationAutomatic
Set DataSheet = ActiveSheet
StartDate = DataSheet.Range("B2").Value
EndDate = DataSheet.Range("B3").Value
Symbol = DataSheet.Range("B4").Value
Range("C7").CurrentRegion.ClearContents
'construct the URL for the query
qurl = "YAHOO OLD LINK" & Symbol
qurl = qurl & "&a=" & Month(StartDate) - 1 & "&b=" & Day(StartDate) & _
"&c=" & Year(StartDate) & "&d=" & Month(EndDate) - 1 & "&e=" & _
Day(EndDate) & "&f=" & Year(EndDate) & "&g=d" & "&q=q&y=0&z=" & _
Symbol & "&x=.csv"
QueryQuote:
With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("C7"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
Range("C7").CurrentRegion.TextToColumns Destination:=Range("C7"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, other:=False
Range("C1:I1").Select
Selection.ColumnWidth = 8
'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 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
i = 8
qurl = "YAHOO OLD LINK" + Cells(i, 3)
i = i + 1
While Cells(i, 3) <> "" And i < 200
qurl = qurl + "+" + Cells(i, 3)
i = i + 1
Wend
qurl = qurl + "&f=n"
' Range("c1") = qurl
QueryQuote:
With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl, Destination:=DataSheet.Range("A8"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
Range("A8").CurrentRegion.TextToColumns Destination:=Range("A8"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, other:=False
'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
Bookmarks