Option Explicit
Sub UpdateStockPrices()
Dim i As Long
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim lastrow As Long
Dim lastcol As Long
Dim lastcol2 As Long
Dim lastrow2 As Long
Dim x As Long
Dim y As Long
Dim z As Long
Dim stperiod As String
Dim endperiod As String
Dim stmonth As Long
Dim styr As Long
Dim endmonth As Long
Dim endyr As Long
Set ws = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
lastcol = ws.Cells(2, Columns.Count).End(xlToLeft).Column
ws.Range(Cells(1, 2).Address & ":" & Cells(lastrow, _
lastcol).Address).Clear
ws2.Cells.Clear
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
stperiod = Application.InputBox("ex 01/2008", "Enter Start Date", , , , ,
_
2)
endperiod = Application.InputBox("ex 01/2008", "Enter End Date", , , , , ,
_
2)
If stperiod = "False" Or endperiod = "False" Then Exit Sub
stmonth = Split(stperiod, "/")(0)
styr = Split(stperiod, "/")(1)
endmonth = Split(endperiod, "/")(0)
endyr = Split(endperiod, "/")(1)
For i = 2 To lastrow
ws2.Cells.Clear
With _
ws2.QueryTables.Add(Connection:="URL;http://finance.yahoo.com/q/hp?s="
_
& ws.Range("A" & i).Value & "&&a=" & stmonth - 1 & "&b=31&c=" &
_
styr & "&d=" & endmonth - 1 & "&e=31&f=" & endyr & "&g=m", _
Destination:=ws2.Range("$A$1"))
.Name = "hp?s=MSFT&a=02&b=13&c=1986&d=08&e=9&f=2008&g= m"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "20"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
lastrow2 = ws2.Cells(Rows.Count, "B").End(xlUp).Row
x = 2
With ws2
For z = lastrow2 To 2 Step -1
If InStr(1, .Range("B" & z), "Dividend") Then
.Range("B" & z).EntireRow.Delete
Else
ws.Cells(i, x).Value = ws2.Range("E" & z).Value
x = x + 1
End If
Next
End With
Next
With ws
lastcol2 = .Cells(2, Columns.Count).End(xlToLeft).Column
For y = 2 To lastcol2
.Cells(1, y).Value = DateSerial(styr, stmonth + y - 1, 0)
.Columns(y).AutoFit
Next
End With
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
--
Gary
"HappySenior" wrote in message
...
On Sep 6, 3:38 pm, "Gary Keramidas" <GKeramidasATmsn.com wrote:
something i cobbled together. i put symbols in column A starting in row 2 and
the last price is entered in column B
watch out for wordwrap on the query line and just put it all on 1 line after
you
paste it in the module.
someone else may have something more elegant, though.
Sub UpdateStockPrices()
Dim lPrice As Double
Dim i As Long
Dim ws As Worksheet
Dim ws2 As Worksheet
Dim lastrow As Long
Set ws = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
ws.Range("B2:B" & lastrow).Clear
ws2.Cells.Clear
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For i = 2 To lastrow
With ws2.QueryTables.Add(Connection:="URL;http://finance.yahoo.com/q/cq?s=" &
_
ws.Range("A" & i), Destination:=ws2.Range("$A$1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = "10"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
ws.Range("B" & i).Value = ws2.Range("C2").Value
Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
--
Gary
"HappySenior" wrote in message
...
Hi,
Hope someone can help with this problem.
I have 12 to 15 stocks for which I want to download closing market
priceson various dates from some some Internet site such as Yahoo
Finance.
Has anybody got a routine where I could do a query with a supplied
date and obtain closingpriceson a table of stocks?
There must be an easier way then multiple requests for individual
stocks...
Many thanks.
Don in Montana- Hide quoted text -
- Show quoted text -
Gary,
Really appreciate your attempt to fulfill my request but your query
would apparently only produce current prices at the time of the
query.
Apparently I wasn't clear enough. I am seeking a query that would get
the end-of-month stock prices for 10 to 12 different stocks. I know
that I can visit Yahoo finance and get historical month-end prices
prices for a date range for a particular stock. I could then print out
a report for that stock and change the symbol for the next stock in my
list.
That seems like a dumb way to automate me instead of my computer.
It would be much easier to design a routine that gets all the prices
for say 1/31/2008 and posts it to column b, then re-run the query
after changing the date and get the data for column c (02/29/2008).
I hope someone out there knows of a way to modify Gary's code to
accomplish this VBA newbie's desires. Note: Yahoo's historical prices
are at
http://www.finance.yahoo.com/q/hp?s=[stock symbol]. Do not
include the braces when entering a stock symbol like GE.
I tried my own macro which queried for a single stock for a single
date. The yield was a Yahoo welcome screen with options and several
subsequent screens that finally took me to the stock and then to the
historical price. The procedure yielded almost 200 rows of data when
it should have only been at most two rows.
Please help a 72 year-old retiree who enjoys the mental challenge...
Many thanks,
Don in Montana