Import from finance.yahoo.com

R

ryguy7272

I submitted a post on this DG a few days ago, and got some help at that time,
but now I've hit a wall again... I am looking up data for about 100 stock
symbols on finance.yahoo.com. I am importing information for these stocks
and, approximately 90% of the time the data is fine, but the rest of the
time, I seem to access the wrong data. The problem is with something called
WebTables. A recorded macro will yield something like .WebTables = "48,53"
and this usually gives me what I want, but for certain stock symbols, the
Web.Tables are slightly different, like .WebTables = "46,51" or .WebTables =
"47,52". The WebTables data should correspond to data from "KEY STATISTICS"
and data from "ANALYST". (see: http://finance.yahoo.com/q?s=pfe). The
Yahoo people always report the relevant information in "KEY STATISTICS" and
"ANALYST", but the WebTables are sometimes numbered differently (i.e.,
"48,53", or "47,52", or "46,51"). Do I need to use XML to reference the
correct "KEY STATISTICS" and "ANALYST" information or can VBA do it for me?
If so, how do I do this (I don't know anything about XML). Any assistance
would be Gretel appreciated!

My code is listed below:

Sub HistData()

Application.ScreenUpdating = False

Dim str1 As String
Dim str2 As String
Dim c As Range
Dim d As Range

Dim bFound As Boolean
Dim ws As Worksheet

For Each c In Sheets("ZZZ - USA Firms").Range("D3:D92")


bFound = False
For Each ws In Worksheets
If ws.Name = c.Value Then
bFound = True
Exit For
End If
Next ws

If bFound = False Then
Worksheets.Add.Name = c.Value
End If

'----------------------------------------------------------

Sheets(c.Value).Select
Cells.Select
Range("A1:IV50000").ClearContents

str1 = "URL;http://finance.yahoo.com/q/hp?s=" & _
c.Value & "&a=00&b=1&c=2007&d=02&e=14&f=2007&g=d"
str2 = "hp?s=" & c.Value & "a=00&b=1&c=2007&d=02&e=14&f=2007&g=d"

With ActiveSheet.QueryTables.Add(Connection:=str1 _
, Destination:=Range("A1"))

.Name = str2

.Name = "hp?s=KFT&a=00&b=1&c=2007&d=02&e=14&f=2007&g=d"

.FieldNames = True
.RowNumbers = False
.WebTables = "20"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Columns("A:A").ColumnWidth = 11.14

Cells.Select
With Selection
.MergeCells = False
End With

'----------------------------------

Columns("C:C").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlToLeft

For Each d In Sheets("ZZZ - USA Firms").Range("D3:D4")

str1 = "URL;http://finance.yahoo.com/q?s=" & _
c.Value
str2 = "q?s=" & c.Value

With ActiveSheet.QueryTables.Add(Connection:=str1 _
, Destination:=Range("I1"))

.Name = str2

.Name = "hp?s=KFT&a=00&b=1&c=2007&d=02&e=14&f=2007&g=d"

.FieldNames = True
.RowNumbers = False
.WebTables = "48,53"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Columns("A:A").ColumnWidth = 11.14

Cells.Select
With Selection
.MergeCells = False
End With

Range("H:D").Select
Selection.Delete Shift:=xlToLeft

' Range("A1").Select
'----------------------------------
Next d
Next c

Sheets("ZZZ - USA Firms").Activate
Range("A1:B1").Select

End Sub
 
D

Don Guillett

It appears that you have a very large workbook with a lot of overhead and
excess of queries and names. Send it to me if you like and I will have a
look. Or, I can send you (ONLY if you ask OFF list) my
GetYahooMultipleHistory97a
which will get the history for as many as you like. There is also a nice
graph that will graph each upon a double click on the symbol.
 
R

rbnorth

I do the same thing to gather stock data and have had the same problem. I
solved it by setting the webtables to read .webtables=46,47,48,51,52,53 In
otherwords, I import a range of tables. This does require, however, that when
you go in to pick out data that your data collection is row independent,
because sometimes a value appears on row 15 and next time it may be on row
23. You can test and see how stable it is for you. In my case I search the
rows for the the text that defines the data (which generally imports to
column A) and then pick off the value from column B next to it. Hope this
helps.
 
R

Randy Harmelink

These two Yahoo groups are good for stock market related discussions
related to EXCEL:

http://tech.groups.yahoo.com/group/xltraders/
http://finance.groups.yahoo.com/group/smf_addin/

The second group is mine. The files area has a free open-source add-
in, documentation on its functions, and sample templates showing usage
of those functions to retrieve data from the web. I initially wrote
the add-in because of issues I had with Web Queries in EXCEL --
specifically, that they almost always require using RELATIVE location
of the table because web designers don't name their tables. This
means any time an advertisement with a table is added or deleted from
the web page, the RELATIVE location of the table or tables you want
will change.
 
R

ryguy7272

Yes, yes, Yes, search the rows for the text that defines the data... I
thought of that too. How do you do it?

I have a macro that creates spreadsheets and then imports the data to the
relevant sheet. I need to loop through each sheet and find certain strings,
such as "Forward P/E (1 yr):", "PEG Ratio (5 yr expected):", "Annual EPS Est
(Aug-07):" (the (Aug-07) part is certain to create obvious problems unless I
can set this up to search for "ESP" within the string), etc. Then I have to
find the value to the right of this string (perhaps offset (0 ,1)).
Everything is summarized on my “Summary Sheetâ€. I can’t tell the Summary
Sheet to reference other sheets because they haven’t been created yet, but
after they are created I want to identify the Forward P/E, etc. on each sheet
and copy/past each value to my Summary Sheet… Any ideas…

Regards,
RyGuy
 
R

Randy Harmelink

With the add-in I mentioned in the other message, you could get the
PEG ratio for IBM with this formula:

=RCHGetElementNumber("IBM",945)

It is one of thousands that are preprogrammed. Or, you could use
another function to do custom extractions yourself. For example, the
PEG ratio can also be retrieved with:

=RCHGetTableCell("http://finance.yahoo.com/q/ks?s=IBM",1,">PEG Ratio")
 
R

rbnorth

Your on the right track. I start with a counter row=1 to 100 and use the
Instr() function (that way you dont have to worry about the dates). When you
find the data you just say for example

If Instr("Annual EPS Est ",cells(row,1).value) then AnnEPS=cells(row,2).value

Now having said that, the procedure I have is quite cumbersum and there are
always spots where exceptions have to be corrected. I've included my code for
KeyStatistics below. I AM going to look very closely at Ryguy7272's procedures

The code:

Sub WebRetreiveStockKeyStatistics(stksym)
'
' GetStockKeyStatistics Macro
' Macro recorded 3/7/2004 by R. Bruce North

' Clear Sheet

Sheets("Web Data").Select
'Cells.Select
'Selection.ClearContents

Const KeyStatTables = "17,22,25,28,31,34,37,47,50,53"

'
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;http://finance.yahoo.com/q/ks?s=" & stksym,
Destination:=Range("A1"))
.Name = "ks?s=" & stksym
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.WebSelectionType = xlSpecifiedTables
' .WebSelectionType = xlAllTables note: do not use
.WebFormatting = xlWebFormattingNone

.WebTables = KeyStatTables ' rbn note ketstat tables are currently

.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With


Columns("A:A").ColumnWidth = 37
Columns("B:B").ColumnWidth = 18.14
Columns("B:B").HorizontalAlignment = xlCenter

For Row = 1 To 100

If InStr(Cells(Row, 2).Value, "N/A") > 0 Then
ElseIf InStr(Cells(Row, 1).Value, "Market Cap") > 0 Then
StockStatistics(1).MarketCap = Text2Num(Cells(Row, 2).Value)
Cells(Row, 3).Value = StockStatistics(1).MarketCap
ElseIf InStr(Cells(Row, 1).Value, "Enterprise Value (") > 0 Then
StockStatistics(1).EnterpriseValue = Text2Num(Cells(Row, 2).Value)
Cells(Row, 3).Value = StockStatistics(1).EnterpriseValue
ElseIf InStr(Cells(Row, 1).Value, "Trailing P/E") > 0 Then
StockStatistics(1).TrailingPE = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).TrailingPE
ElseIf InStr(Cells(Row, 1).Value, "Forward P/E") > 0 Then
StockStatistics(1).ForwardPE = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).ForwardPE
ElseIf InStr(Cells(Row, 1).Value, "PEG Ratio (5 yr expected)") > 0 Then
StockStatistics(1).PEGRatio = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).PEGRatio
ElseIf InStr(Cells(Row, 1).Value, "Price/Sales") > 0 Then
StockStatistics(1).PriceSales = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).PriceSales
ElseIf InStr(Cells(Row, 1).Value, "Price/Book") > 0 Then
StockStatistics(1).PriceBook = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).PriceBook
ElseIf InStr(Cells(Row, 1).Value, "Enterprise Value/Revenue") > 0 Then
If Cells(Row, 2) = "Na%0" Then Cells(Row, 2) = 0
If Cells(Row, 2) = "NaN" Then Cells(Row, 2) = 0
StockStatistics(1).EntValueRevenue = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).EntValueRevenue
ElseIf InStr(Cells(Row, 1).Value, "Enterprise Value/EBITDA") > 0 Then
StockStatistics(1).EntValueEBITDA = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).EntValueEBITDA

ElseIf InStr(Cells(Row, 1).Value, "Fiscal Year Ends") > 0 Then
StockStatistics(1).FiscalYearEnds = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).FiscalYearEnds
ElseIf InStr(Cells(Row, 1).Value, "Most Recent Quarter") > 0 Then
StockStatistics(1).MostRecentQuarter = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).MostRecentQuarter

ElseIf InStr(Cells(Row, 1).Value, "From Operations") > 0 Then
StockStatistics(1).CashFlowFromOps = Text2Num(Cells(Row, 2).Value)
Cells(Row, 3).Value = StockStatistics(1).CashFlowFromOps
ElseIf InStr(Cells(Row, 1).Value, "Free Cashflow") > 0 Then
StockStatistics(1).FreeCashFlow = Text2Num(Cells(Row, 2).Value)
Cells(Row, 3).Value = StockStatistics(1).FreeCashFlow



ElseIf InStr(Cells(Row, 1).Value, "Profit Margin") > 0 Then
StockStatistics(1).ProfitMargin = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).ProfitMargin
ElseIf InStr(Cells(Row, 1).Value, "Operating Margin (ttm):") > 0 Then
StockStatistics(1).OperatingMargin = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).OperatingMargin
ElseIf InStr(Cells(Row, 1).Value, "Return on Assets (ttm):") > 0 Then
StockStatistics(1).ReturnonAssets = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).ReturnonAssets
ElseIf InStr(Cells(Row, 1).Value, "Return on Equity (ttm):") > 0 Then
StockStatistics(1).ReturnonEquity = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).ReturnonEquity
ElseIf InStr(Cells(Row, 1).Value, "Revenue (ttm):") > 0 Then
StockStatistics(1).Revenue = Text2Num(Cells(Row, 2).Value)
Cells(Row, 3).Value = StockStatistics(1).Revenue

ElseIf InStr(Cells(Row, 1).Value, "Revenue Per Share") > 0 Then
StockStatistics(1).RevenuePerShare = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).RevenuePerShare
ElseIf InStr(Cells(Row, 1).Value, "Operating Margin (ttm):") > 0 Then
StockStatistics(1).OperatingMargin = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).OperatingMargin
ElseIf InStr(Cells(Row, 1).Value, "Return on Assets (ttm):") > 0 Then
StockStatistics(1).ReturnonAssets = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).ReturnonAssets
ElseIf InStr(Cells(Row, 1).Value, "Return on Equity (ttm):") > 0 Then
StockStatistics(1).ReturnonEquity = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).ReturnonEquity
ElseIf InStr(Cells(Row, 1).Value, "Revenue (ttm):") > 0 Then
StockStatistics(1).Revenue = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).Revenue

ElseIf InStr(Cells(Row, 1).Value, "Revenue Per Share (ttm):") > 0 Then
StockStatistics(1).RevenuePerShare = Text2Num(Cells(Row, 2).Value)
Cells(Row, 3).Value = StockStatistics(1).RevenuePerShare
ElseIf InStr(Cells(Row, 1).Value, "Revenue Growth (") > 0 Then
StockStatistics(1).RevenueGrowth = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).RevenueGrowth
ElseIf InStr(Cells(Row, 1).Value, "Gross Profit (ttm):") > 0 Then
StockStatistics(1).GrossProfit = Text2Num(Cells(Row, 2).Value)
Cells(Row, 3).Value = StockStatistics(1).GrossProfit
ElseIf InStr(Cells(Row, 1).Value, "EBITDA (ttm):") > 0 Then
StockStatistics(1).EBITDA = Text2Num(Cells(Row, 2).Value)
Cells(Row, 3).Value = StockStatistics(1).EBITDA
ElseIf InStr(Cells(Row, 1).Value, "Net Income Avl to Common (ttm):") > 0
Then
StockStatistics(1).NetIncomeAvltoCommon = Text2Num(Cells(Row,
2).Value)
Cells(Row, 3).Value = StockStatistics(1).NetIncomeAvltoCommon

ElseIf InStr(Cells(Row, 1).Value, "Diluted EPS (ttm):") > 0 Then
StockStatistics(1).DilutedEPS = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).DilutedEPS
ElseIf InStr(Cells(Row, 1).Value, "Earnings Growth") > 0 Then
StockStatistics(1).EarningsGrowth = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).EarningsGrowth
ElseIf InStr(Cells(Row, 1).Value, "Total Cash (mrq):") > 0 Then
StockStatistics(1).TotalCash = Text2Num(Cells(Row, 2).Value)
Cells(Row, 3).Value = StockStatistics(1).TotalCash
ElseIf InStr(Cells(Row, 1).Value, "Total Cash Per Share (mrq):") > 0 Then
StockStatistics(1).TotalCashPerShare = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).TotalCashPerShare
ElseIf InStr(Cells(Row, 1).Value, "Total Debt (mrq):") > 0 Then
StockStatistics(1).TotalDebt = Text2Num(Cells(Row, 2).Value)
Cells(Row, 3).Value = StockStatistics(1).TotalDebt

ElseIf InStr(Cells(Row, 1).Value, "Total Debt/Equity (mrq):") > 0 Then
StockStatistics(1).TotalDebttoEquity = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).TotalDebttoEquity
ElseIf InStr(Cells(Row, 1).Value, "Current Ratio") > 0 Then
StockStatistics(1).CurrentRatio = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).CurrentRatio
ElseIf InStr(Cells(Row, 1).Value, "Book Value Per Share (mrq):") > 0 Then
StockStatistics(1).BookValuePerShare = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).BookValuePerShare
ElseIf InStr(Cells(Row, 1).Value, "Beta:") > 0 Then
StockStatistics(1).Beta = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).Beta
ElseIf InStr(Cells(Row, 1).Value, "52-Week Change") > 0 Then
StockStatistics(1).Wk52Change = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).Wk52Change

ElseIf InStr(Cells(Row, 1).Value, "S&P50052-Week Change") > 0 Then
StockStatistics(1).Wk52ChangeRelativetoSP500 = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).Wk52ChangeRelativetoSP500
ElseIf InStr(Cells(Row, 1).Value, "52-Week High") > 0 Then
StockStatistics(1).Wk52High = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).Wk52High
ElseIf InStr(Cells(Row, 1).Value, "52-Week Low") > 0 Then
StockStatistics(1).Wk52Low = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).Wk52Low
ElseIf InStr(Cells(Row, 1).Value, "50-Day Moving Average") > 0 Then
StockStatistics(1).MovingAverage50day = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).MovingAverage50day
ElseIf InStr(Cells(Row, 1).Value, "200-Day Moving Average") > 0 Then
StockStatistics(1).MovingAverage200day = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).MovingAverage200day

ElseIf InStr(Cells(Row, 1).Value, "Average Volume (3 month)") > 0 Then
StockStatistics(1).AverageVol3month = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).AverageVol3month
ElseIf InStr(Cells(Row, 1).Value, "Average Volume (10 day)") > 0 Then
StockStatistics(1).AverageVol10Day = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).AverageVol10Day
ElseIf InStr(Cells(Row, 1).Value, "Shares Outstanding:") > 0 Then
StockStatistics(1).SharesOutstanding = Text2Num(Cells(Row, 2).Value)
Cells(Row, 3).Value = StockStatistics(1).SharesOutstanding
ElseIf InStr(Cells(Row, 1).Value, "% Held by Insiders") > 0 Then
StockStatistics(1).PcntHeldInsiders = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).PcntHeldInsiders
ElseIf InStr(Cells(Row, 1).Value, "% Held by Institutions") > 0 Then
StockStatistics(1).PcntHeldInstitutions = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).PcntHeldInstitutions

ElseIf InStr(Cells(Row, 1).Value, "Shares Short") > 0 Then
StockStatistics(1).SharesShort = Text2Num(Cells(Row, 2).Value)
Cells(Row, 3).Value = StockStatistics(1).SharesShort
ElseIf InStr(Cells(Row, 1).Value, "Daily Volume") > 0 Then
StockStatistics(1).DailyVolume = Text2Num(Cells(Row, 2).Value)
Cells(Row, 3).Value = StockStatistics(1).DailyVolume
ElseIf InStr(Cells(Row, 1).Value, "Short Ratio") > 0 Then
StockStatistics(1).ShortRatio = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).ShortRatio
ElseIf InStr(Cells(Row, 1).Value, "Short % of Float") > 0 Then
StockStatistics(1).ShortPcntofFloat = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).ShortPcntofFloat
ElseIf InStr(Cells(Row, 1).Value, "Shares Short (prior month)") > 0 Then
StockStatistics(1).SharesShortPrior = Cells(Row, 2).Value
Cells(Row, 3).Value = Text2Num(StockStatistics(1).SharesShortPrior)

ElseIf InStr(Cells(Row, 1).Value, "Float") > 0 Then
StockStatistics(1).Float = Text2Num(Cells(Row, 2).Value)
Cells(Row, 3).Value = StockStatistics(1).Float

ElseIf InStr(Cells(Row, 1).Value, "Forward Annual Dividend Rate") > 0 Then
StockStatistics(1).ForAnnualDividendRate = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).ForAnnualDividendRate
ElseIf InStr(Cells(Row, 1).Value, "Forward Annual Dividend Yield") > 0
Then
StockStatistics(1).ForDividendYield = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).ForDividendYield
ElseIf InStr(Cells(Row, 1).Value, "Trailing Annual Dividend Yield") > 0
Then
If Cells(Row, 2) = "Na%0" Then Cells(Row, 2) = 0
If Cells(Row, 2) = "NaN%" Then Cells(Row, 2) = 0
StockStatistics(1).TrailDividendYield = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).TrailDividendYield
ElseIf InStr(Cells(Row, 1).Value, "Trailing Annual Dividend Rate") > 0
Then
StockStatistics(1).TrailAnnualDividendRate = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).TrailAnnualDividendRate
ElseIf InStr(Cells(Row, 1).Value, "5 Year Average Dividend Yield") > 0
Then
StockStatistics(1).AvgDivYield5Yr = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).AvgDivYield5Yr
ElseIf InStr(Cells(Row, 1).Value, "Payout Ratio") > 0 Then
StockStatistics(1).PayoutRatio = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).PayoutRatio
ElseIf InStr(Cells(Row, 1).Value, "Ex-Dividend Date") > 0 Then
StockStatistics(1).ExDividendDate = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).ExDividendDate
ElseIf InStr(Cells(Row, 1).Value, "Dividend Date") > 0 Then
StockStatistics(1).DividendDate = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).DividendDate
ElseIf InStr(Cells(Row, 1).Value, "Last Split Factor") > 0 Then
StockStatistics(1).LastSplitFactor = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).LastSplitFactor
ElseIf InStr(Cells(Row, 1).Value, "Last Split Date") > 0 Then
StockStatistics(1).LastSplitDate = Cells(Row, 2).Value
Cells(Row, 3).Value = StockStatistics(1).LastSplitDate
End If
Next
End Sub
 
R

rbnorth

Sorry, I gave your ID but I what I meant was that I was going to check out
Randy Harmelinks addins. It might make life alot easier
 
D

Don Guillett

I don't think I have ever seen anything quite like this. Quite cumbersome,
indeed.
What does it do?
What is wrong with FIND (look in vba help)
 
R

rbnorth

Don,

Thanks for your comment

What does this procedure do? After importing a webquery from yahoo.com
containing tables of stock statistics, it runs down the page and pulls the
statistics into a variable array that can then be used for calculating
various stock evaluation criteria.

You could do the same thing using the 'find' command and I guess not have to
keep track of rows and columns. Although you would have to know where the
find was because you need to pull the data from the adjacent cell.

Using the find command might also allow you to pull in the whole page (using
..WebSelectionType = xlAllTables) in the web query. This would make the whole
procedure a lot more stable. I'll have to try it and see what happens. How do
you identify the row and column when the find command finds what your looking
for?

This code could be cleaned up as well by placing the 'searched for' text in
an array and then looping through the array. To be honest, it was faster for
me to code using a cut and paste, and once it worked, I moved on to other
things. I'm not a professional programmer. Sloppy but it works

Thanks again for your comments
 
D

Don Guillett

It appears that you are drawing in ONE symbol data and then trying to find
the data for another sheet.
Market Cap (intraday): 142.27B
Enterprise Value (20-Mar-07)3: 153.53B
Trailing P/E (ttm, intraday): 15.47
Forward P/E (fye 31-Dec-08) 1: 12.79
PEG Ratio (5 yr expected): 1.26

=======
You are really making this a lot more difficult than it should be. Instead
of creating a new query for each symbol, I would do this by establishing the
query and just using a refresh to get the data (or multiple symbols in a
loop). Then simply use an INDIRECT VLOOKUP formula in the other sheet. Super
quick and a loop could be used so that it would look like my table in my
file available free at the yahoo group xltraders.GetYahooMultipleHistory97a
Or, I can email one.
It also appears that you are not deleting the query name created with each
web fetch. Maybe there is something I don't understand. Send me your file if
you like and I will take a look.
 
R

ryguy7272

As I mentioned before, I am posting the final version of VBA code for the
benefit of others. I want to take a moment to say thanks to merjet (for
giving me the code to loop through my array, which is named ‘myRange’) and
thanks to Jim Thomlinson (for giving me the code to search ranges in multiple
worksheets). I know there are many VBA experts out there who can poke lots
of holes in the structure, and probably logic, of this program, but I chose
to do it this way to contain all of the relevant stock information on a sheet
specific to each stock, and then create a ‘Summary Sheet’ where certain data
elements are copied/pasted. I thought the use of this ‘Summary Sheet’ was
mostly intuitive, and overall made sense. Also, I have to admit, I had tons
of help doing this thing. Don and rbnorth underscored some good points, but
in all honesty, I don’t know how to implement some of the recommendations
that they made. I am still learning, and I know I have a lot of work to do
to become proficient with VBA; I’m just placing my code here so that others
who may look at this post might find bits and pieces of VBA syntax that they
can use for their own needs.


‘To import data (insert into one module)
Sub HistData()

Application.ScreenUpdating = False

‘merjet’s code
Dim str1 As String
Dim str2 As String
Dim c As Range

Dim myRange As Range


Dim bFound As Boolean
Dim ws As Worksheet


Set myRange = Application.InputBox( _
"Type 'myRange' in the input box below", Type:=8)

For Each c In Sheets("ZZZ - USA Firms").Range("myRange")

bFound = False
For Each ws In Worksheets
If ws.Name = c.Value Then
bFound = True
Exit For
End If
Next ws

If bFound = False Then
Worksheets.Add.Name = c.Value
End If

'----------------------------------------------------------
Sheets(c.Value).Select
Cells.Select
Range("A1:IV65536").ClearContents

str1 = "URL;http://finance.yahoo.com/q/hp?s=" & _
c.Value
str2 = "hp?s=" & c.Value

With ActiveSheet.QueryTables.Add(Connection:=str1 _
, Destination:=Range("A1"))

.Name = str2

.Name = "hp?s=c.Value"


.FieldNames = True
.RowNumbers = False
.WebTables = "20"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Columns("A:A").ColumnWidth = 11.14

Cells.Select
With Selection
.MergeCells = False
End With

Selection.ColumnWidth = 14.57
Range("B:D,F:K").Select
Columns("C:C").Select

'----------------------------------------------------------

Range("AA1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlToLeft



str1 = "URL;http://finance.yahoo.com/q?s=" & _
c.Value
str2 = "q?s=" & c.Value

With ActiveSheet.QueryTables.Add(Connection:=str1 _
, Destination:=Range("AA1"))

.Name = str2

.Name = "q?s=c.Value"

.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = True
.Refresh BackgroundQuery:=False
End With

Range("B:D,F:Z").Select
Range("F1").Activate
Selection.Delete Shift:=xlToLeft

Columns("D:H").Select
Selection.Delete Shift:=xlToLeft
'----------------------------------
Range("BA1").Select



str1 = "URL;http://finance.yahoo.com/q/ks?s=" & _
c.Value
str2 = "q/ks?s=" & c.Value

With ActiveSheet.QueryTables.Add(Connection:=str1 _
, Destination:=Range("BA1"))

.Name = str2

.Name = "ks?s=c.Value"

.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = True
.Refresh BackgroundQuery:=False
End With

Selection.ClearContents
Columns("G:AD").Select
Selection.Delete Shift:=xlToLeft
'----------------------------------
Sheets(c.Value).Select

Range("CA1").Select

str1 = "URL;http://finance.yahoo.com/q/pr?s=" & _
c.Value
str2 = "pr?s=" & c.Value

With ActiveSheet.QueryTables.Add(Connection:=str1 _
, Destination:=Range("CA1"))

.Name = str2

.Name = "pr?s=c.Value"


.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

Columns("J:AG").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
'----------------------------------

Next c


On Error GoTo 0

Sheets("ZZZ - USA Firms").Activate
Range("A1:B1").Select

End Sub


‘To search range in multiple worksheets and copy/paste matching items to my
‘Summary Sheet

‘Jim Thomlinson’s code
Public Sub CopyAll()
Call CopyFromSheets("D", "Forward*", "C")
Call CopyFromSheets("D", "P/S*", "D")
Call CopyFromSheets("D", "PEG*", "E")
Call CopyFromSheets("D", "Annual EPS*", "F")
Call CopyFromSheets("D", "Mean*", "G")
Call CopyFromSheets("L", "Beta*", "H")
End Sub

Private Sub CopyFromSheets(ByVal strCol As String, _
ByVal strWhat As String, ByVal strPasteCol As String)
Dim wks As Worksheet
Dim rngFound As Range
Dim rngPaste As Range

Set rngPaste = Sheets("ZZZ - USA Firms, Summary").Cells(Rows.Count, _
strPasteCol).End(xlUp).Offset(1, 0)
For Each wks In Worksheets
On Error Resume Next
Set rngFound = FindStuff(wks.Columns(strCol), strWhat)
On Error GoTo 0


If Not rngFound Is Nothing Then
rngFound.Offset(0, 1).Copy rngPaste
Set rngFound = Nothing

End If

Set rngPaste = rngPaste.Offset(1, 0)
Next wks
End Sub

Private Function FindStuff(ByVal rngToSearch As Range, _
ByVal strWhat As String) As Range

Dim rngFound As Range
Dim rngFoundAll As Range
Dim strFirstAddress As String

Set rngFound = rngToSearch.Find(What:=strWhat, _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
MatchCase:=False)
If rngFound Is Nothing Then
Set FindStuff = Nothing
Else
Set rngFoundAll = rngFound
strFirstAddress = rngFound.Address
Do
Set rngFoundAll = Union(rngFound, rngFoundAll)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
Set FindStuff = rngFoundAll
End If
End Function

Public Sub CorpGov()
Call CopyFromSheets2("BJ:BK", "Corporate Governance Quotient*", "J")
Range("I3").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[1]<>"""",""Better than ""&MID(RC[1],FIND(""than
"",RC[1])+5,99),"""")"
Selection.AutoFill Destination:=Range("I3:I200"),
Type:=xlFillDefault
Columns("J:J").Select
Selection.ColumnWidth = 0
Range("A1").Select
End Sub

Private Sub CopyFromSheets2(ByVal strCol As String, _
ByVal strWhat As String, ByVal strPasteCol As String)
Dim wks2 As Worksheet
Dim rngFound2 As Range
Dim rngPaste2 As Range

Set rngPaste2 = Sheets("ZZZ - USA Firms, Summary").Cells(Rows.Count, _
strPasteCol).End(xlUp).Offset(1, 0)
For Each wks In Worksheets
On Error Resume Next
Set rngFound2 = FindStuff(wks.Columns(strCol), strWhat)
On Error GoTo 0


If Not rngFound2 Is Nothing Then
rngFound2.Offset(0, 0).Copy rngPaste2
Set rngFound2 = Nothing

End If

Set rngPaste2 = rngPaste2.Offset(1, 0)
Next wks
End Sub

Private Function FindStuff2(ByVal rngToSearch As Range, _
ByVal strWhat As String) As Range

Dim rngFound2 As Range
Dim rngFoundAll2 As Range
Dim strFirstAddress2 As String

Set rngFound2 = rngToSearch.Find(What:=strWhat, _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
MatchCase:=False)
If rngFound2 Is Nothing Then
Set FindStuff2 = Nothing
Else
Set rngFoundAll2 = rngFound
strFirstAddress2 = rngFound.Address
Do
Set rngFoundAll2 = Union(rngFound, rngFoundAll)
Set rngFound2 = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress2
Set FindStuff2 = rngFoundAll2
End If
End Function


‘This copies the name of each worksheet into a column on the ‘Summary Sheet’
Sub ListSheets()

Dim rng1 As Range
Dim i As Integer

Set rng1 = Range("A3")
For Each Sheet In ActiveWorkbook.Sheets
rng1.Offset(i, 0).Value = Sheet.Name
i = i + 1
Next Sheet

End Sub


‘Finally (almost done), this creates a reference for the stock price
information from each worksheet, to the ‘Summary Sheet’


Sub CreateLinkedSummary()
Dim SNames() As String
Dim myAdd As String
Dim myRange As Range
Dim mySS As Worksheet
Dim i As Integer
Dim SCnt As Integer
Dim myCol As Integer

'---
Dim Sh As Worksheet
Dim blnReplace As Boolean

blnReplace = False
For Each Sh In ActiveWorkbook.Worksheets
If InStr(1, Sh.Name, "Z") Or InStr(1, Sh.Name, "Summary Sheet") Then
blnReplace = False

Else

Sh.Select blnReplace
End If
Next Sh

'---

SCnt = ActiveWindow.SelectedSheets.Count

If SCnt = 1 Then
If MsgBox("Are you sure - only one sheet?", vbYesNo) _
= vbYes Then
GoTo ShtOK
Else
MsgBox "Select the sheets and re-run the macro."
Exit Sub
End If
End If

ShtOK:

ReDim SNames(1 To SCnt)

For i = 1 To SCnt
SNames(i) = ActiveWindow.SelectedSheets(i).Name
Next i


Set myRange = Range("B2")
'myRange.Offset(0, 3) = ActiveSheet.Range("B2")
'Set myRange = Application.InputBox( _
' "Select Range to link from", Type:=8)
myAdd = myRange.Address
'myRange.Offset(0, 3) = ActiveSheet.Range("B2")


myAdd = myRange.Address
Set myRange = Range("B3")
'myRange.Offset(0, 3) = ActiveSheet.Range("B3")
'Set myRange = Application.InputBox( _
' "Select sheet and range to link to.", Type:=8)
'myRange.Offset(0, 3) = ActiveSheet.Range("B3")

Set mySS = myRange.Parent
myCol = myRange(1).Column
Worksheets(SNames(1)).Range(myAdd).Copy
mySS.Select
myRange.Select
mySS.Paste Link:=True


For i = 2 To SCnt
Worksheets(SNames(i)).Range(myAdd).Copy
mySS.Cells(mySS.Rows.Count, myCol).End(xlUp)(2).Select
mySS.Paste Link:=True
Next i

myRange.Select
Application.CutCopyMode = False
End Sub

'This is the end...
 
D

Don Guillett

As I had mentioned before, you could have had a looping macro to get the
history on datasht1 and copy the history for that symbol to the summary
sheet. Another loop for the p/e ratios copying to the sumary sheet. One
mouse click for all with about 1 second spent on each web fetch. 2 queries
only similar to my history file.
You may also want to consider what to do with the build up of defined names
resulting from each web fetch?

for each n in names
'make an exception to any to keep
n.delete
next

--
Don Guillett
SalesAid Software
(e-mail address removed)
ryguy7272 said:
As I mentioned before, I am posting the final version of VBA code for the
benefit of others. I want to take a moment to say thanks to merjet (for
giving me the code to loop through my array, which is named 'myRange') and
thanks to Jim Thomlinson (for giving me the code to search ranges in
multiple
worksheets). I know there are many VBA experts out there who can poke
lots
of holes in the structure, and probably logic, of this program, but I
chose
to do it this way to contain all of the relevant stock information on a
sheet
specific to each stock, and then create a 'Summary Sheet' where certain
data
elements are copied/pasted. I thought the use of this 'Summary Sheet' was
mostly intuitive, and overall made sense. Also, I have to admit, I had
tons
of help doing this thing. Don and rbnorth underscored some good points,
but
in all honesty, I don't know how to implement some of the recommendations
that they made. I am still learning, and I know I have a lot of work to
do
to become proficient with VBA; I'm just placing my code here so that
others
who may look at this post might find bits and pieces of VBA syntax that
they
can use for their own needs.


'To import data (insert into one module)
Sub HistData()

Application.ScreenUpdating = False

'merjet's code
Dim str1 As String
Dim str2 As String
Dim c As Range

Dim myRange As Range


Dim bFound As Boolean
Dim ws As Worksheet


Set myRange = Application.InputBox( _
"Type 'myRange' in the input box below", Type:=8)

For Each c In Sheets("ZZZ - USA Firms").Range("myRange")

bFound = False
For Each ws In Worksheets
If ws.Name = c.Value Then
bFound = True
Exit For
End If
Next ws

If bFound = False Then
Worksheets.Add.Name = c.Value
End If

'----------------------------------------------------------
Sheets(c.Value).Select
Cells.Select
Range("A1:IV65536").ClearContents

str1 = "URL;http://finance.yahoo.com/q/hp?s=" & _
c.Value
str2 = "hp?s=" & c.Value

With ActiveSheet.QueryTables.Add(Connection:=str1 _
, Destination:=Range("A1"))

.Name = str2

.Name = "hp?s=c.Value"


.FieldNames = True
.RowNumbers = False
.WebTables = "20"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Columns("A:A").ColumnWidth = 11.14

Cells.Select
With Selection
.MergeCells = False
End With

Selection.ColumnWidth = 14.57
Range("B:D,F:K").Select
Columns("C:C").Select

'----------------------------------------------------------

Range("AA1").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Delete Shift:=xlToLeft



str1 = "URL;http://finance.yahoo.com/q?s=" & _
c.Value
str2 = "q?s=" & c.Value

With ActiveSheet.QueryTables.Add(Connection:=str1 _
, Destination:=Range("AA1"))

.Name = str2

.Name = "q?s=c.Value"

.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = True
.Refresh BackgroundQuery:=False
End With

Range("B:D,F:Z").Select
Range("F1").Activate
Selection.Delete Shift:=xlToLeft

Columns("D:H").Select
Selection.Delete Shift:=xlToLeft
'----------------------------------
Range("BA1").Select



str1 = "URL;http://finance.yahoo.com/q/ks?s=" & _
c.Value
str2 = "q/ks?s=" & c.Value

With ActiveSheet.QueryTables.Add(Connection:=str1 _
, Destination:=Range("BA1"))

.Name = str2

.Name = "ks?s=c.Value"

.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = True
.Refresh BackgroundQuery:=False
End With

Selection.ClearContents
Columns("G:AD").Select
Selection.Delete Shift:=xlToLeft
'----------------------------------
Sheets(c.Value).Select

Range("CA1").Select

str1 = "URL;http://finance.yahoo.com/q/pr?s=" & _
c.Value
str2 = "pr?s=" & c.Value

With ActiveSheet.QueryTables.Add(Connection:=str1 _
, Destination:=Range("CA1"))

.Name = str2

.Name = "pr?s=c.Value"


.WebSelectionType = xlEntirePage
.WebFormatting = xlWebFormattingNone
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With

Columns("J:AG").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
'----------------------------------

Next c


On Error GoTo 0

Sheets("ZZZ - USA Firms").Activate
Range("A1:B1").Select

End Sub


'To search range in multiple worksheets and copy/paste matching items to
my
'Summary Sheet

'Jim Thomlinson's code
Public Sub CopyAll()
Call CopyFromSheets("D", "Forward*", "C")
Call CopyFromSheets("D", "P/S*", "D")
Call CopyFromSheets("D", "PEG*", "E")
Call CopyFromSheets("D", "Annual EPS*", "F")
Call CopyFromSheets("D", "Mean*", "G")
Call CopyFromSheets("L", "Beta*", "H")
End Sub

Private Sub CopyFromSheets(ByVal strCol As String, _
ByVal strWhat As String, ByVal strPasteCol As String)
Dim wks As Worksheet
Dim rngFound As Range
Dim rngPaste As Range

Set rngPaste = Sheets("ZZZ - USA Firms, Summary").Cells(Rows.Count, _
strPasteCol).End(xlUp).Offset(1, 0)
For Each wks In Worksheets
On Error Resume Next
Set rngFound = FindStuff(wks.Columns(strCol), strWhat)
On Error GoTo 0


If Not rngFound Is Nothing Then
rngFound.Offset(0, 1).Copy rngPaste
Set rngFound = Nothing

End If

Set rngPaste = rngPaste.Offset(1, 0)
Next wks
End Sub

Private Function FindStuff(ByVal rngToSearch As Range, _
ByVal strWhat As String) As Range

Dim rngFound As Range
Dim rngFoundAll As Range
Dim strFirstAddress As String

Set rngFound = rngToSearch.Find(What:=strWhat, _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
MatchCase:=False)
If rngFound Is Nothing Then
Set FindStuff = Nothing
Else
Set rngFoundAll = rngFound
strFirstAddress = rngFound.Address
Do
Set rngFoundAll = Union(rngFound, rngFoundAll)
Set rngFound = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress
Set FindStuff = rngFoundAll
End If
End Function

Public Sub CorpGov()
Call CopyFromSheets2("BJ:BK", "Corporate Governance Quotient*", "J")
Range("I3").Select
ActiveCell.FormulaR1C1 = _
"=IF(RC[1]<>"""",""Better than ""&MID(RC[1],FIND(""than
"",RC[1])+5,99),"""")"
Selection.AutoFill Destination:=Range("I3:I200"),
Type:=xlFillDefault
Columns("J:J").Select
Selection.ColumnWidth = 0
Range("A1").Select
End Sub

Private Sub CopyFromSheets2(ByVal strCol As String, _
ByVal strWhat As String, ByVal strPasteCol As String)
Dim wks2 As Worksheet
Dim rngFound2 As Range
Dim rngPaste2 As Range

Set rngPaste2 = Sheets("ZZZ - USA Firms, Summary").Cells(Rows.Count, _
strPasteCol).End(xlUp).Offset(1, 0)
For Each wks In Worksheets
On Error Resume Next
Set rngFound2 = FindStuff(wks.Columns(strCol), strWhat)
On Error GoTo 0


If Not rngFound2 Is Nothing Then
rngFound2.Offset(0, 0).Copy rngPaste2
Set rngFound2 = Nothing

End If

Set rngPaste2 = rngPaste2.Offset(1, 0)
Next wks
End Sub

Private Function FindStuff2(ByVal rngToSearch As Range, _
ByVal strWhat As String) As Range

Dim rngFound2 As Range
Dim rngFoundAll2 As Range
Dim strFirstAddress2 As String

Set rngFound2 = rngToSearch.Find(What:=strWhat, _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
MatchCase:=False)
If rngFound2 Is Nothing Then
Set FindStuff2 = Nothing
Else
Set rngFoundAll2 = rngFound
strFirstAddress2 = rngFound.Address
Do
Set rngFoundAll2 = Union(rngFound, rngFoundAll)
Set rngFound2 = rngToSearch.FindNext(rngFound)
Loop Until rngFound.Address = strFirstAddress2
Set FindStuff2 = rngFoundAll2
End If
End Function


'This copies the name of each worksheet into a column on the 'Summary
Sheet'
Sub ListSheets()

Dim rng1 As Range
Dim i As Integer

Set rng1 = Range("A3")
For Each Sheet In ActiveWorkbook.Sheets
rng1.Offset(i, 0).Value = Sheet.Name
i = i + 1
Next Sheet

End Sub


'Finally (almost done), this creates a reference for the stock price
information from each worksheet, to the 'Summary Sheet'


Sub CreateLinkedSummary()
Dim SNames() As String
Dim myAdd As String
Dim myRange As Range
Dim mySS As Worksheet
Dim i As Integer
Dim SCnt As Integer
Dim myCol As Integer

'---
Dim Sh As Worksheet
Dim blnReplace As Boolean

blnReplace = False
For Each Sh In ActiveWorkbook.Worksheets
If InStr(1, Sh.Name, "Z") Or InStr(1, Sh.Name, "Summary Sheet")
Then
blnReplace = False

Else

Sh.Select blnReplace
End If
Next Sh

'---

SCnt = ActiveWindow.SelectedSheets.Count

If SCnt = 1 Then
If MsgBox("Are you sure - only one sheet?", vbYesNo) _
= vbYes Then
GoTo ShtOK
Else
MsgBox "Select the sheets and re-run the macro."
Exit Sub
End If
End If

ShtOK:

ReDim SNames(1 To SCnt)

For i = 1 To SCnt
SNames(i) = ActiveWindow.SelectedSheets(i).Name
Next i


Set myRange = Range("B2")
'myRange.Offset(0, 3) = ActiveSheet.Range("B2")
'Set myRange = Application.InputBox( _
' "Select Range to link from", Type:=8)
myAdd = myRange.Address
'myRange.Offset(0, 3) = ActiveSheet.Range("B2")


myAdd = myRange.Address
Set myRange = Range("B3")
'myRange.Offset(0, 3) = ActiveSheet.Range("B3")
'Set myRange = Application.InputBox( _
' "Select sheet and range to link to.", Type:=8)
'myRange.Offset(0, 3) = ActiveSheet.Range("B3")

Set mySS = myRange.Parent
myCol = myRange(1).Column
Worksheets(SNames(1)).Range(myAdd).Copy
mySS.Select
myRange.Select
mySS.Paste Link:=True


For i = 2 To SCnt
Worksheets(SNames(i)).Range(myAdd).Copy
mySS.Cells(mySS.Rows.Count, myCol).End(xlUp)(2).Select
mySS.Paste Link:=True
Next i

myRange.Select
Application.CutCopyMode = False
End Sub

'This is the end...

--
RyGuy


Don Guillett said:
It appears that you are drawing in ONE symbol data and then trying to
find
the data for another sheet.
Market Cap (intraday): 142.27B
Enterprise Value (20-Mar-07)3: 153.53B
Trailing P/E (ttm, intraday): 15.47
Forward P/E (fye 31-Dec-08) 1: 12.79
PEG Ratio (5 yr expected): 1.26

=======
You are really making this a lot more difficult than it should be.
Instead
of creating a new query for each symbol, I would do this by establishing
the
query and just using a refresh to get the data (or multiple symbols in a
loop). Then simply use an INDIRECT VLOOKUP formula in the other sheet.
Super
quick and a loop could be used so that it would look like my table in my
file available free at the yahoo group
xltraders.GetYahooMultipleHistory97a
Or, I can email one.
It also appears that you are not deleting the query name created with
each
web fetch. Maybe there is something I don't understand. Send me your file
if
you like and I will take a look.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top