Download Stock prices to excell spreadsheet

[Nick]

Hello,
I have consolidated my stock portfolios to one excell
spreadsheet and I would like to pull down the latest
stock prices to the excell spreadheet.

Do you know the easiest way to do that?

Please respond directlty to nic...@yahoo.com

Thank You!

[Don Guillett]

Here are a couple. Let me know how it works for you.

Sub SetArray()
For Each ce In Range("SymbolsA") 'Range("a6:a12")
mystring = mystring + ce.Value + "+"
Next
mystringend = mystring + "^&d=e"
'MsgBox mystringend
'qurl = "http://quote.yahoo.com/q?s=T+CSCO+FE+^&d=e"
qurl = "http://quote.yahoo.com/q?s=" & mystringend
With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl,
Destination:=ActiveSheet.Range("B7"))
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
End Sub

Sub GetStocks()
Dim s As String
Dim web As String
Const YahooStocks As String = "URL;http://quote.yahoo.com/q?s=#+^&d=e"

s = Join(Application.Transpose([StockSymbols]), "+")
web = Replace(YahooStocks, "#", s)

With ActiveSheet.QueryTables.Add(web, [C1])
.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
End Sub
--
Don Guillett
SalesAid Software
Granite Shoals, TX
don...@281.com
"Nick" <nic...@yahoo.com> wrote in message
news:002501c2b478$a0662880$8df82ecf@TK2MSFTNGXA02...

[BrianB]

Try here :-
http://office.microsoft.com/downloads/9798/webcnkit.aspx

Regards
BrianB
=============================================================

"Nick" <nic...@yahoo.com> wrote in message news:<002501c2b478$a0662880$8df82ecf@TK2MSFTNGXA02>...

[Harapa]

I modified this macro to incorporate retrieval in text form rather
than html form. Since Yahoo has a limit of 200 ticker per request,
would you help me to modify this macro so that I can ask for multiple
packets of 200 during the execution of this macro. I can do this by
running multiple copies of this macro for each 200 codes in Column A,
but it would be simpler to have it automated that way I wouln't have
to worry as to how codes I have in column A. Thanks
harapa

Sub SetArry2

For Each ce In Range("A1:A200") 'Range("a6:a12")

mystring = mystring + ce.Value + "+"
Next

mystringend = mystring + "&f=sl1d1t1c1ohgv&e=.csv"
MsgBox mystringend
'qurl = http://finance.yahoo.com/d/quotes.csv?s=T+CSCO+FE+^&d=e"
qurl = "http://finance.yahoo.com/d/quotes.csv?s=" & mystringend

With ActiveSheet.QueryTables.Add(Connection:="URL;" & qurl,

Destination:=ActiveSheet.Range("B1"))

.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With
End Sub

"Don Guillett" <don...@281.com> wrote in message news:<eyYtvcLtCHA.1132@TK2MSFTNGP12>...

[David McRitchie]

I wonder if it might not be better to use the spreadsheet form at Yahoo rather
than the web page. At the bottom of the stocks table you will see a download
spreadsheet option.
http://finance.yahoo.com/d/quotes.csv?s=T+CSCO+FE+^&f=st5l9c6p4b1a3&e=.csv

My thoughts are that this would eliminate some of the problems where sites
change things around and if your macro such as a web query macro are
dependent on a specific web page format you have to rewrite your macro
everytime someone changes the basic layout or add another advertisement.
When I ran your macros I essentially got the web page plopped onto the
spreadsheet, which was not what I was expecting.

Chip Pearson has some sample web query macros for stock quotes, and I
almost guarantee that one would have to modify them to work today.
Microsoft has some web query examples based on their own financial site
so it they change the format then their examples won't work so they may be
more stable for doing this than Yahoo. For links on these see my
stocks.htm page.

---
HTH,
David McRitchie, Microsoft MVP - Excel [site changed Nov. 2001]
My Excel Macros: http://www.mvps.org/dmcritchie/excel/excel.htm
Search Page: http://www.mvps.org/dmcritchie/excel/search.htm

"Don Guillett" <don...@281.com> wrote in message news:eyYtvcLtCHA.1132@TK2MSFTNGP12...

[Dave Peterson]

I've never worked with queries before, so Don (et al) can correct this (and
inform me where I went wrong):

I retrieved 200 stocks at a time. But each group of 200 made the previous group
go over one column.

So since I didn't know better, I just kept column A and before I started,
deleted B:IV.

Then I retrieved 1300 stocks (in my test). Then I got rid of the extra cells
that were inserted before each group. And did a text to columns to get
individual cells.

I don't know why they got forced to the adjacent column, but I do know if you
have any data to the right of column A, I'll delete it. (So try it against a
test workbook.)

Option Explicit

Sub testme()

Application.ScreenUpdating = False

Dim ce As Range
Dim LastRow As Long
Dim myGroup As Long
Dim myStep As Long
Dim iRow As Long
Dim myString As String
Dim myStringEnd As String
Dim qURL As String

myStep = 200

With ActiveSheet
.Columns("B:IV").Delete

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

For iRow = 1 To LastRow Step myStep
If iRow > LastRow Then Exit For

myString = ""
For Each ce In .Cells(iRow, "A").Resize(myStep)
If ce.Row > LastRow Then Exit For
myString = myString & ce.Value & "+"
Next
myStringEnd = myString + "&f=sl1d1t1c1ohgv&e=.csv"
' MsgBox myStringEnd
'qurl = http://finance.yahoo.com/d/quotes.csv?s=T+CSCO+FE+^&d=e"
qURL = "http://finance.yahoo.com/d/quotes.csv?s=" & myStringEnd
With .QueryTables.Add(Connection:="URL;" & qURL, _
Destination:=.Cells(iRow, "B"))

.BackgroundQuery = True
.TablesOnlyFromHTML = False
.Refresh BackgroundQuery:=False
.SaveData = True
End With

Next iRow
.Columns("B:iv").SpecialCells(xlCellTypeBlanks).Delete _
Shift:=xlToLeft

Application.DisplayAlerts = False
.Columns("B:B").TextToColumns Destination:=Range("B1"), _
DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 3), _
Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1))
Application.DisplayAlerts = True

.UsedRange.Columns.AutoFit
End With

Application.ScreenUpdating = True
End Sub

--

Dave Peterson
ec3...@msn.com

[Harapa]

I am not a VBA expert. And I had a similar problem that is why I
posted this here. I think the problem is that the output range is
static i.e. "B2". Unless that is made dynamic i.e. to shift down by
200 cells (something I donot know how to do ) you will contineu to
have aoverwrite, unless you find some other alternate as you
dewcribed. It is kind of annoying. So now I have modified a procedure
that I copied from David McRitchie's site. Take a look. You need to
make a worko book with two sheets. Name one 'Symbols' and other as
'data'. Put all symbols you have in column 'A' of the symbols sheets.
Macro will retrive quotes from yahoo in batches of 200 and apppend in
sheet data and format to produce follwing layout Code, Data, Open,
High, Low, Close, Volume. Good luck.
...................
Sub GetStockQuotes()
'Queries Yahoo for list of symbols in Column A on WorkSheet
"Yahoo_Test2".
'Yahoo only allows 200 symbols per shot. Splits into 200 symbols lots.
'Dumps data into "Data" WorkSheet & Parses data
'AddSheetsFromRange 'Macro to Add New sheets for each symbol added

Dim intI As Integer
Dim intJ As Integer
Dim rngF As Range
Dim rngFilter As Range
Dim strFilter() As String
Dim strURL As String
'Name and location of input file (Symbol/data sheets)
Workbooks.Open filename:="C:\Financial\Yahoo_Test.xls"

Application.ScreenUpdating = False

Sheets("Symbols").Select
intCount = 0
intJ = 0
ReDim strFilter(intJ)
Set rngFilter = Range(Cells(1, 1), Cells(1, 1).End(xlDown))

For Each rngF In rngFilter
strFilter(intJ) = strFilter(intJ) & rngF.Value & "+"
intCount = intCount + 1
If intCount > 199 Then
intJ = intJ + 1
ReDim Preserve strFilter(intJ)
intCount = 0
End If
Next rngF

Sheets("Data").Select
Cells.Delete
For intI = 0 To intJ

strURL = "http://finance.yahoo.com/d/quotes.csv?s=" &
strFilter(intI) _
& "&f=sl1d1t1c1ohgv&e=.csv"
'MsgBox strURL
With ActiveWorkbook.Worksheets("Data").QueryTables.Add _
(Connection:="URL;" & strURL, Destination:=Worksheets("Data")
_
.Cells(intI * 200 + 1, 1))
.FieldNames = False
.RefreshStyle = xlInsertDeleteCells
.RowNumbers = False
.FillAdjacentFormulas = False
.RefreshOnFileOpen = False
.HasAutoFormat = True
.BackgroundQuery = True
.TablesOnlyFromHTML = True
.Refresh BackgroundQuery:=False
.SavePassword = False

.SaveData = True
End With

Next intI

'Convert Imported Data from Text to Columns
'Part II
'Here you can modify to include or exclude data columns.
'At this time it is set to keep Ticker, Data, Open, High, Low, Close
and Volume fields
Columns("A:A").Select
Selection.TextToColumns Destination:=Range("A1"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False,

Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=False,

FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 9),
Array(5, 9), Array(6, 1), _

Array(7, 1), Array(8, 1), Array(9, 1))

'Part III
'Rearrange Data as Ticker, Date, Open, High, Low, Close and Volume
Columns("B:B").Select
Selection.Copy
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
Columns("B:B").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
'Part IV
'Format Date field
Columns("B:B").Select
Selection.NumberFormat = "mm/dd/yyyy"
Columns("A:G").Select
Selection.Sort Key1:=Range("C1"), Order1:=xlDescending,
Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Columns("A:J").EntireColumn.AutoFit
Range("A1").Select
'Part V
'To Save File As a Todate.csv file
'You can change this to any format such as .csv, .txt, or .xls by
adjusting parameters
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs filename:="C:\Financial\Historical
Data\" _
& Format(Date, "yyyymmdd"), FileFormat:=xlCSV, CreateBackup:=False
'Inactivate if you want to keep the file open
'ActiveWorkbook.Close
Sheets("SYMBOLS").Select

'====SORT SYMBOLS LIST
' Rows("5:" & [SymbolsList].Rows.Count + 3).Sort
Key1:=Range("A5"),Order1:=xlAscending
Application.ScreenUpdating = True

End Sub

Dave Peterson <ec3...@msn.com> wrote in message news:<3E1A1379...@msn.com>...