Re: Import from finance.yahoo.com

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)

--
Don Guillett
SalesAid Software
dguillett1@xxxxxxxxxxxxx
"rbnorth" <rbnorth@xxxxxxxxxxxxxxxxxxxxxxxxx> wrote in message
news:E536B455-FE06-44FD-AF64-31CC5745DDBB@xxxxxxxxxxxxxxxx
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 ***

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

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

'
With Active***.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



"ryguy7272" wrote:

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 ***. I need to loop through each *** 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 ***". 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
***
and copy/past each value to my Summary ***. Any ideas.

Regards,
RyGuy




"rbnorth" wrote:

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.

"ryguy7272" wrote:

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 Work***

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 Active***.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 Active***.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

--
RyGuy
PS, thanks for the solution to the looping problem Merjet!!


.

Loading