T
TEB2
Background: I have to evaluate over 500 stocks on a monthly basis to
determine the market-to-cost adjustment. Part of the process is to compare
the current market price to the previous six month high.
The following 2 subs go to Yahoo Finance and pulls 6 pieces of information:
symbol, date, open, high, low, close based on the date range I enter.
However, it is limited by the 256 columns in Excel. Therefore, I can only
download 49 stocks at a time. I need help converting this code to Access so
I can download all 500 stock's data into a table. Also, I want to maintain
the stock symbols to look up in a seperate table called "Stocks".
Sub GetStockData()
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 = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Set DataSheet = ActiveSheet
StartDate = DataSheet.Range("B2").Value
EndDate = DataSheet.Range("B3").Value
Symbol = DataSheet.Range("B4").Value
Range("C7").CurrentRegion.ClearContents
'URL for the query
qurl = "http://chart.yahoo.com/table.csv?s=" & 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("G3") &
"&q=q&y=0&z=" & _
Symbol & "&x=.csv"
Range("b5") = qurl
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(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"
With ThisWorkbook
For Each nQuery In Names
If IsNumeric(Right(nQuery.Name, 1)) Then
nQuery.Delete
End If
Next nQuery
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Range("C7:I2000").Select
Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("C1").Select
Selection.ColumnWidth = 12
Range("B4").Select
End Sub
Sub SaveStockData()
Dim n As Integer, i As Integer
n = Range("L4")
clear
For i = 1 To n
Range("B4") = Cells(7 + i, 11)
GetData
Cells(6, 5 * i + 7) = Cells(7 + i, 11)
Range("C7:G2000").Select
Selection.Copy
Cells(7, 5 * i + 7).Select
ActiveSheet.Paste
Cells(6, 5 * i + 7).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 48
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 48
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 48
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 48
End With
Next i
Range("A1").Select
End Sub
determine the market-to-cost adjustment. Part of the process is to compare
the current market price to the previous six month high.
The following 2 subs go to Yahoo Finance and pulls 6 pieces of information:
symbol, date, open, high, low, close based on the date range I enter.
However, it is limited by the 256 columns in Excel. Therefore, I can only
download 49 stocks at a time. I need help converting this code to Access so
I can download all 500 stock's data into a table. Also, I want to maintain
the stock symbols to look up in a seperate table called "Stocks".
Sub GetStockData()
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 = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual
Set DataSheet = ActiveSheet
StartDate = DataSheet.Range("B2").Value
EndDate = DataSheet.Range("B3").Value
Symbol = DataSheet.Range("B4").Value
Range("C7").CurrentRegion.ClearContents
'URL for the query
qurl = "http://chart.yahoo.com/table.csv?s=" & 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("G3") &
"&q=q&y=0&z=" & _
Symbol & "&x=.csv"
Range("b5") = qurl
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(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"
With ThisWorkbook
For Each nQuery In Names
If IsNumeric(Right(nQuery.Name, 1)) Then
nQuery.Delete
End If
Next nQuery
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Range("C7:I2000").Select
Selection.Sort Key1:=Range("C8"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("C1").Select
Selection.ColumnWidth = 12
Range("B4").Select
End Sub
Sub SaveStockData()
Dim n As Integer, i As Integer
n = Range("L4")
clear
For i = 1 To n
Range("B4") = Cells(7 + i, 11)
GetData
Cells(6, 5 * i + 7) = Cells(7 + i, 11)
Range("C7:G2000").Select
Selection.Copy
Cells(7, 5 * i + 7).Select
ActiveSheet.Paste
Cells(6, 5 * i + 7).Select
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 48
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 48
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 48
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThick
.ColorIndex = 48
End With
Next i
Range("A1").Select
End Sub