The following code does what you're looking to do. Note it makes use of
named ranges as opposed to standard cell references, so you may need to
adjust to suit. Nonetheless it gives you information on how to extract data
from a web page.
Code:
Sub quoteY()
'================================================= ==================================
'
' This pulls company name and current quotes in from Yahoo to the area
' adjacecnt to a vertical column of ticker symbols that are named "tickers"
'
' It relies on Yahoo's "download spreadsheet" function
'
http://finance.yahoo.com/d/quotes.csv?s=yhoo&f=l1
'
' Jason Chroman
' September 14, 2006
'
'================================================= ==================================
Dim qt As QueryTable
Dim tickerstring, connectstring As String
Dim k As Integer
DeleteHiddenNamesAndQueryTables
tickerstring = commaconcat(Range("tickers"))
connectstring = "URL;http://finance.yahoo.com/d/quotes.csv?s=" &
tickerstring & "&f=n"
'pull the names with the first query
Set qt = ActiveSheet.QueryTables.Add(Connection:=connectstr ing,
Destination:=ActiveSheet.Range("tickers").Offset(0 , 1))
With qt
.Name = "T1"
.AdjustColumnWidth = False
.RefreshStyle = xlOverwriteCells
.RefreshOnFileOpen = False
.Refresh
End With
'pull the prices with the second query
connectstring = "URL;http://finance.yahoo.com/d/quotes.csv?s=" &
tickerstring & "&f=l1"
Set qt = ActiveSheet.QueryTables.Add(Connection:=connectstr ing,
Destination:=ActiveSheet.Range("tickers").Offset(0 , 2))
With qt
.Name = "T1"
.AdjustColumnWidth = False
.RefreshStyle = xlOverwriteCells
.RefreshOnFileOpen = False
.Refresh
End With
'insert current date and time
Application.Goto Reference:="pulldate"
ActiveCell.Value = Now
Application.Goto Reference:="pulltime"
ActiveCell.Value = Now
End Sub
Sub DeleteHiddenNamesAndQueryTables()
Dim n As Name
Dim strX As String
Dim CountA, CountB As Integer
Dim qt As QueryTable
CountA = 0
For Each n In ActiveSheet.Names
x = Mid(n.Name, 8, 2)
If x = "T1" Then
On Error Resume Next
n.Delete
CountA = CountA + 1
End If
Next n
'CountB = ActiveSheet.QueryTables.Count
CountB = 0
For Each qt In ActiveSheet.QueryTables
qt.Delete
CountB = CountB + 1
Next qt
'MsgBox (CountB & " hidden query tables were deleted. " & Chr(13) & "There
were " & CountA & " hidden names that were deleted.")
End Sub
Function commaconcat(avec As Range) As String
'given a set of ticker symbols, this function separates them with commas
' any blanks are set as "." dots
Dim i, L, numitems As Integer
Dim val, temp As String
numitems = avec.Rows.Count
For Each cell In avec
i = i + 1
L = Len(cell.Value)
If L = 0 Then
val = "/"
Else
val = cell.Value
End If
If i < numitems Then
temp = temp & val & ","
Else
temp = temp & val
End If
Next cell
commaconcat = temp
End Function
Sub RecordUpdates()
'
' This is just a simple copy/paste
'
Application.Goto Reference:="currentcase"
Application.CutCopyMode = False
Selection.Copy
Application.Goto Reference:="priorcase"
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.Goto Reference:="R1C1"
End Sub
--
Brevity is the soul of wit.
"Kaleidoscopic Perspectives" wrote:
I have the following stock symbols:
SYMBOL
NCST
CRMH
PXPL
DEIX
EMS
SPSN
CNCP
CPA
RPB
STP
SCOP
TRAK
I also know where the URL for information on these stocks reside. They
reside at:
http://finance.yahoo.com/q/ks?s=NCST
http://finance.yahoo.com/q/ks?s=CRMH
http://finance.yahoo.com/q/ks?s=PXPL
http://finance.yahoo.com/q/ks?s=DEIX
http://finance.yahoo.com/q/ks?s=EMS
http://finance.yahoo.com/q/ks?s=SPSN
http://finance.yahoo.com/q/ks?s=CNCP
http://finance.yahoo.com/q/ks?s=CPA
http://finance.yahoo.com/q/ks?s=RPB
http://finance.yahoo.com/q/ks?s=STP
http://finance.yahoo.com/q/ks?s=SCOP
http://finance.yahoo.com/q/ks?s=TRAK
Note: The URL addresses were made using the concatenate function:
=concatenate ("http://finance.yahoo.com/q/ks?s=", a2) ---- Where
a2 is the stock symbol.
Now, here's where it gets interesting. How do I:
1. Extract specific information for each of the websites, such as
http://finance.yahoo.com/q/ks?s=NCST? Specifically, I'd like to be
able to copy and paste one of the cells of this page. I'd like to do
this task for everyone of those stocks (i.e. URLs) listed above.
Thanks in advance.