On Sep 9, 7:07*pm, "Gary Keramidas" <GKeramidasATmsn.com wrote:
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 currentpricesat the time of the
query.

Apparently I wasn't clear enough. I am seeking a query that would get
the end-of-monthstockpricesfor 10 to 12 different stocks. I know
that I can visit Yahoo finance and get historical month-endpricespricesfor a date range for a particularstock. I could then print out
a report for thatstockand change the symbol for the nextstockin 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 theprices
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 historicalprices
are athttp://www.finance.yahoo.com/q/hp?s=[stocksymbol]. Do not
include the braces when entering astocksymbol like GE.

I tried my own macro which queried for a singlestockfor a single
date. The yield was a Yahoo welcome screen with options and several
subsequent screens that finally took me to thestockand 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- Hide quoted text -

- Show quoted text -
Gary,
Thanks for the revised routine but I am having trouble trying to run
it.
The line that begins with stperiod = Application.InputBox("ex
01/2008", "Enter Start Date apparently continues through to after End
Date." I have it entered on a single line. It appears that you are
asking for two different values (stperiod and endperiod) in a single
inputbox. Is that correct? I get an error on that line.
I also get an error on the line " styr = Split(stperiod, "/")(1) ". I
found nothing that helps me understand this line which is supposed to
be extracting the year from "07/2008".

I modified the query to substitute actual data. When the code ran I
ended up with blanks on both sheet1 and sheet2 and the cursor on
sheet2 cell d1.

Incidentally, is there a way to store memory variables when running a
macro? In Foxpro, I can capture a picture of memory variables to a
file while the program is executing. I was hoping that I store
stperiod, endperiod, etc. on sheet3 in a cell adjoinging the variable
name which I would previously label.

Your help is greatly appreciated.
Don