Hi,
Hope someone can help with this problem.
I have 12 to 15 stocks for which I want to download closing market
prices on 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 closing prices on a table of stocks?

There must be an easier way then multiple requests for individual
stocks...

Many thanks.
Don in Montana

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
prices on 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 closing prices on a table of stocks?

There must be an easier way then multiple requests for individual
stocks...

Many thanks.
Don in Montana

Here are two functions I wrote a couple of years ago
(when I was new to VBA) that shoud read in 3 years
(adjustable) worth of Historical Prices from YAHOO on
the symbol and write it out to a *.CSV file (Date,Open,
High,Low,Close,Volume). Be sure to set the location
where you want the file to be written. I think every
thing is here that you need. It will check for stock
splits and dividends (remove if not needed). You will
need a worksheet named 'WebData' and a global string
variable called 'URL_Text'. If anything is missing,
let me know. Watch out for wordwrap.
-pb
'* - - - - - - - - - - -
Function Yahoo_History(CurSym As String) As Boolean

Dim Hstry_Dt(1000) As Date
Dim Hstry_Op(1000) As Single
Dim Hstry_Lo(1000) As Single
Dim Hstry_Hi(1000) As Single
Dim Hstry_Cl(1000) As Single
Dim Hstry_Vo(1000) As Single
Dim CvtAmt As Single
Dim CvtRte As Single
Dim DteLmt As Date
Dim SymDte As Date
Dim FilObj As Object
Dim FilRcd As Integer
Dim FlgErr As Boolean
Dim fso ' File System Object
Dim PagCnt As Integer
Dim PagRcd As Integer
Dim Char01 As Long
Dim Char02 As Long
Dim SymRow As Long
Dim ShrNew As Single
Dim ShrOld As Single
Dim TmpRng As Range
Dim TmpSng As Single
Dim TmpStr As String

Yahoo_History = False

' clear the arrays
For FilRcd = 1 To 1000
Hstry_Dt(FilRcd) = 0: Hstry_Op(FilRcd) = 0: Hstry_Hi(FilRcd)
= 0
Hstry_Lo(FilRcd) = 0: Hstry_Cl(FilRcd) = 0: Hstry_Vo(FilRcd)
= 0
Next FilRcd

CvtAmt = 0
CvtRte = 1#
DteLmt = DateAdd("M", 36 * -1, Date) ' 36 Months / 3 Years
FilRcd = 0
PagCnt = 0

' Load the Web Data
URL_Text = "http://finance.yahoo.com/q/hp?s=" & Symb_Yah
Yahoo_History_Label_1:
FlgErr = WebData_Get("20", URL_Text)

' read through the page
PagRcd = 0
For Each TmpRng In Worksheets("WebData").Range("A3:A100")
If (Not IsDate(TmpRng.Value)) Then Exit For
' check date
If (TmpRng.Value < DteLmt Or FilRcd 800) Then Exit For
' non numeric value in column 2?
TmpStr = TmpRng.Offset(0, 1).Value
If (Not IsNumeric(TmpStr)) Then
' check for a SPLIT
Char02 = InStr(1, Trim(TmpStr), "Stock Split")
If (Char02 < 0) Then
Char01 = InStr(1, TmpStr, ":")
ShrNew = Mid(TmpStr, 1, Char01 - 1)
ShrOld = Mid(TmpStr, Char01 + 1, (Char02 - Char01) -
1)
CvtRte = CvtRte * (ShrOld / ShrNew)
End If
' check for a DIVIDEND
Char02 = InStr(1, Trim(TmpStr), "Dividend")
If (Char02 < 0) Then
Char01 = InStr(1, TmpStr, "$")
TmpSng = Mid(TmpStr, Char01 + 1, (Char02 - Char01) -
1)
CvtAmt = CvtAmt + TmpSng
End If
Else
FilRcd = FilRcd + 1
' check if this is new data
If (FilRcd = 1) Then
SymRow = Get_Symbol_Row(Symb_Wks)
If (TmpRng.Value = Sheets("Symbols").Range("D" &
SymRow)) Then
Exit Function
End If
End If
' load the arrays
Hstry_Dt(FilRcd) = TmpRng.Value
Hstry_Op(FilRcd) = (TmpRng.Offset(0, 1).Value - CvtAmt) *
CvtRte
Hstry_Hi(FilRcd) = (TmpRng.Offset(0, 2).Value - CvtAmt) *
CvtRte
Hstry_Lo(FilRcd) = (TmpRng.Offset(0, 3).Value - CvtAmt) *
CvtRte
Hstry_Cl(FilRcd) = (TmpRng.Offset(0, 4).Value - CvtAmt) *
CvtRte
Hstry_Vo(FilRcd) = TmpRng.Offset(0, 5).Value
Yahoo_History = True
PagRcd = PagRcd + 1
End If
Next

' end of the data?
If (PagRcd = 66) Then
PagCnt = PagCnt + 1
URL_Text = "http://finance.yahoo.com/q/hp?s=" & Symb_Yah & _
"&d=" & Mid(Str(Month(Now) - 1), 2) & _
"&e=" & Mid(Str(Day(Now)), 2) & _
"&f=" & Mid(Str(Year(Now)), 2) & _
"&g=d&z=66&y=" & Mid(Str(PagCnt * 66), 2)
GoTo Yahoo_History_Label_1
End If

' Write History?
If (FilRcd 0) Then
TmpStr = "C:\History\" & Symb_Ash & ".csv"
Set fso = CreateObject("Scripting.FileSystemObject")
Set FilObj = fso.CreateTextFile(TmpStr)
PagRcd = FilRcd
Do While (PagRcd 0)
' change the date from: MM/DD/YYYY -- YYYY/MM/DD
TmpStr = Cvt_Date(Hstry_Dt(PagRcd))
TmpStr = TmpStr & "," & Trim(CStr(Hstry_Op(PagRcd)))
TmpStr = TmpStr & "," & Trim(CStr(Hstry_Hi(PagRcd)))
TmpStr = TmpStr & "," & Trim(CStr(Hstry_Lo(PagRcd)))
TmpStr = TmpStr & "," & Trim(CStr(Hstry_Cl(PagRcd)))
TmpStr = TmpStr & "," & Trim(CStr(Hstry_Vo(PagRcd)))
FilObj.WriteLine TmpStr
PagRcd = PagRcd - 1
Loop

FilObj.Close
Set fso = Nothing
End If

End Function
'* - - - - - - - - - - -
Function WebData_Get(WEB_tbl As String, WEB_url As String) As Boolean

' clear the worksheet
Sheets("WebData").Select
Rows("3:1000").Select
Selection.Delete Shift:=xlUp
Columns("B:AG").Select
Selection.Delete Shift:=xlToLeft

' Load the Web Data
Sheets("WebData").Select
Workbooks(ActiveWorkbook.Name).Sheets("WebData").R ange("A1") = ""
& WEB_url
Range("A2").Select
ActiveCell.Value = ""
WebData_Get = False
If (WEB_tbl = "") Then GoTo WebData_Get_Page

WebData_Get_Table:
On Error GoTo WebData_Get_Error
With Selection.QueryTable
.Name = "WebData"
.Connection = "URL;" & WEB_url
.WebSelectionType = xlSpecifiedTables
.WebFormatting = xlWebFormattingNone
.WebTables = WEB_tbl
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
GoTo WebData_Get_End

WebData_Get_Page:
On Error GoTo WebData_Get_Error
With Selection.QueryTable
.Name = "WebData"
.Connection = "URL;" & WEB_url
.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
GoTo WebData_Get_End

WebData_Get_Error:
WebData_Get = True

WebData_Get_End:
On Error GoTo 0
WEB_tbl = ""
WEB_url = ""

End Function
'* - - - - - - - - - - -

Oop's, you need to remove the following code:
' * - - - - -
' check if this is new data
If (FilRcd = 1) Then
SymRow = Get_Symbol_Row(Symb_Wks)
If (TmpRng.Value = Sheets("Symbols").Range("D" & SymRow)) Then
Exit Function
End If
End If
' * - - - - -
This was something to make sure I didn't down load it
a second time if I already had the most recent data.
-pb

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

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

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

i tried sending you the workbook. you need to enter the start date (month/year)
in the first box, 1/2007, and the end date in the 2nd box, 12/2007.
there's not a lot of error checking in it. it's just something i threw together.

--


Gary


"HappySenior" wrote in message
...
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