Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 2
Default How do I extract information from these websites onto Excel?

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.

  #2   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 2,574
Default How do I extract information from these websites onto Excel?

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.


  #3   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 2
Default How do I extract information from these websites onto Excel?

Dave:

Where does this go in Excel? This looks like Java codes for an online
application.

Thanks.


Dave F wrote:
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.



  #4   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 2,574
Default How do I extract information from these websites onto Excel?

Here's a link to the original file from which I got the code:
http://groups.google.com/group/micro...7c5b0a 2396e1

The code goes in a module, but if you don't know how VBA works you might as
well download the original file rather than re-create the wheel.

Dave
--
Brevity is the soul of wit.


"Kaleidoscopic Perspectives" wrote:

Dave:

Where does this go in Excel? This looks like Java codes for an online
application.

Thanks.


Dave F wrote:
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.




Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Excel 2003 FAILS, but Excel 2000 SUCCEEDS ??? Richard Excel Discussion (Misc queries) 2 May 13th 23 11:46 AM
Stop excel from dropping the 0 in the beginning of a number? Rosewood Setting up and Configuration of Excel 12 April 4th 23 02:12 PM
copy information on a excel sheet and send to an outlook contact? harpscardiff Excel Discussion (Misc queries) 3 March 4th 06 07:41 PM
Import information to Excel Jason Excel Discussion (Misc queries) 2 July 14th 05 06:56 PM
Formatting information copied and pasted from the WEB to excel jbsand1001 Excel Discussion (Misc queries) 5 April 5th 05 09:07 PM


All times are GMT +1. The time now is 10:59 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"