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 LastRow As Long
Dim X As Range
Dim B4 As String
Dim i As Long, endRow As Long, j As Integer
[Link] = False
[Link] = False
[Link] = xlCalculationManual
complete = False
bSymbolNotFound = False 'Greg Lovern
Set DataSheet = ActiveSheet
StartDate = [Link]("B2").Value
EndDate = [Link]("B3").Value
Symbol = [Link]("B4").Value
Range("C7").[Link]
'construct the URL for the query
'Google
qurl = "[Link] & Symbol
qurl = qurl & "&startdate=" & MonthName(Month(StartDate), True) & _
"+" & Day(StartDate) & "+" & Year(StartDate) & _
"&enddate=" & MonthName(Month(EndDate), True) & _
"+" & Day(EndDate) & "+" & Year(EndDate) & "&output=csv"
'Yahoo
' qurl = "[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=" & Range("P2") &
"&q=q&y=0&z=" & _
' Symbol & "&x=.csv"
Range("b5") = qurl
QueryQuote:
'Web query
With [Link](Connection:="URL;" & qurl,
Destination:=[Link]("C7"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
On Error GoTo BadSymbol 'Greg Lovern
.Refresh BackgroundQuery:=False
On Error GoTo 0 'Greg Lovern
.SaveData = True
End With
Range("C7").[Link] Destination:=Range("C7"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,
Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, other:=False
Range(Range("C7"), Range("C7").End(xlDown)).NumberFormat = "mmm
d/yy"
Range(Range("D7"), Range("G7").End(xlDown)).NumberFormat = "0.00"
Range(Range("H7"), Range("H7").End(xlDown)).NumberFormat = "0,000"
Range(Range("I7"), Range("I7").End(xlDown)).NumberFormat = "0.00"
'If Google doesn't return "Adjusted Close", fill col I with
"Close" values
endRow = Range("G65536").End(xlUp).Row
If [Link](endRow, "I") = "" Then
For i = 7 To endRow
[Link](i, "I").Value = [Link](i,
"G").Value
Next
End If
With ThisWorkbook
For Each nQuery In Names
If IsNumeric(Right([Link], 1)) Then
[Link]
End If
Next nQuery
End With
'turn calculation back on
[Link] = xlCalculationAutomatic
[Link] = True
' Range("C7:I2000").Select
' [Link] Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
' OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("C7:I2000").Sort Key1:=Range("C8"), Order1:=xlAscending,
Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'Greg Lovern
' Range("C1").Select
' [Link] = 12
Range("C1").ColumnWidth = 12 'Greg Lovern
UpdateScale
UpdateScale2
UpdateScale3
Range("B4").Select
LastRow = Cells([Link], "I").End(xlUp).Row
Range("BG7").FormulaR1C1 = "=AVERAGE(R" & LastRow - Range("P5") + 1 & "C[-
50]:R" & LastRow & "C[-50])"
'On Error Resume Next
'Range("H4").ClearContents
'Set x = Range("I" & [Link]).End(xlUp)
'Range("H4") = x / [Link](-Range("L6").Value)
'On Error Resume Next
If Sheets("Candles").Range("B4").Value = "DIA" Then
Sheets("Candles").Range("F4").ClearContents 'entry date dow return.
Set X = Sheets("Candles").Range("I" & [Link]).End(xlUp)
Sheets("Candles").Range("F4") = X / [Link](-
Sheets("Candles").Range("L6").Value) - 1
Sheets("Candles").Range("H4").ClearContents
Set X = Sheets("Candles").Range("I" & [Link]).End(xlUp)
Sheets("Candles").Range("H4") = X / [Link](-
Sheets("Candles").Range("L6").Value) - 1
Sheets("Candles").Range("D2").ClearContents
Sheets("Candles").Range("D2") = Sheets("Candles").Range("F3")
Sheets("Candles").Range("D3").ClearContents
Sheets("Candles").Range("D3") = Sheets("Candles").Range("G3")
ElseIf Sheets("Candles").Range("B4").Value <> "DIA" Then
Sheets("Candles").Range("H4").ClearContents 'last close dow return.
Set X = Sheets("Candles").Range("I" & [Link]).End(xlUp)
Sheets("Candles").Range("H4") = X / [Link](-
Sheets("Candles").Range("L6").Value) - 1
End If
'With ActiveSheet
'LastRow = .Cells(.[Link], "I").End(xlUp).Row
'.Range("H4").Value = .Cells(LastRow, "I").Value / .Cells(LastRow -
Range("L6").Value, "I").Value
'End With
Exit Sub 'Greg Lovern
BadSymbol: 'Greg Lovern
bSymbolNotFound = True
MsgBox "Symbol " & Symbol & " not found.", vbCritical + vbOKOnly, "Symbol Not
Found" 'Greg Lovern
[Link] = xlCalculationAutomatic 'Greg Lovern
[Link] = True 'Greg Lovern
End Sub
second one
Sub YahooFinanceQuery()
'PURPOSE: Pull Historical Stock Data From Yahoo! Finance
'SOURCE: [Link]
Dim EndDate As Date
Dim StartDate As Date
Dim StockTicker As String
Dim QueryURL As String
Dim QueryDataRange As Range
Dim QueryLocation As Range
Dim tbl As ListObject
'Optimize Code
[Link] = False
[Link] = False
'Query Parameters
StartDate = Range("C4").Value
EndDate = Range("F4").Value
StockTicker = Range("B2").Value
'Store Table Object to a Variable
Set tbl = [Link]("StockTable")
'Determine Where To Place Query (Column Prior To Table)
Set QueryLocation = [Link](1, 1).Offset(0, -1)
[Link] Shift:=xlToRight,
CopyOrigin:=xlFormatFromLeftOrAbove
Set QueryLocation = [Link](0, -1)
'Delete all table rows except first row
With [Link]
If .[Link] > 1 Then
.Offset(1, 0).Resize(.[Link] - 1, .[Link]).[Link]
End If
End With
'Create Web Address To Query Historic Stock Data
QueryURL = "[Link] & StockTicker
QueryURL = QueryURL & "&a=" & Month(StartDate) - 1 & "&b=" & Day(StartDate)
& _
"&c=" & Year(StartDate) & "&d=" & Month(EndDate) - 1 & "&e=" & _
Day(EndDate) & "&f=" & Year(EndDate) & "&g=" & QueryLocation &
"&q=q&y=0&z=" & _
StockTicker & "&x=.csv"
'Pull Query Into Excel
With [Link](Connection:="URL;" & QueryURL,
Destination:=QueryLocation)
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
'Determine Stock Data Range
[Link]
Set QueryDataRange = [Link](QueryLocation,
Cells([Link] _
([Link], [Link]).End(xlUp).Row - 1,
[Link]))
'Sort Data in Ascending Order
[Link]
[Link] Key:=QueryDataRange, _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With [Link]
.SetRange QueryDataRange
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'Delimit Stock Data into Table
[Link] Destination:=[Link](0, 2),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, other:=False
'Delete Yahoo! Finance Stock Query
[Link]
'Optimize Code
[Link] = True
[Link] = True
End Sub
