I have prepared for my use a macro which not only donwloads yahoo(indias
historical data and also chart it. the macro consist of main macro "daily
chart" in which I call another macro at the end "charting" .I am sending the
2 macros below. They may be clumsy but works
there are only two problems. in.finance.yahoo gives only about three month
sdata in the first page and rest in the next pages. My macro(s) download
only the firt page.
another problem is that in.finance.yahoo takes 24 hours to update. so today
(6 july monring) you will get only upto 4 july.
the macro dorps down an input box where you type the yahoo symbol of the
scrip.e.g.
cipla.ns. unfortunately yahoo in finance does not give historical data for
BSE symbols.
perhaps the macros can be tweked.
if you are interested I can send you my whole workbook as attachment if you
send me a personal email
=============================
Dim symbol
Sub dailychart()
Application.DisplayAlerts = False
Dim enddate, endmonth
enddate = Day(Date)
endmonth = Month(Date)
symbol = Application.InputBox("type yahoo symbol of the scrip as vsnl.ns")
Application.DisplayAlerts = False
On Error Resume Next
Sheets("daily chart").Delete
Worksheets("sheet1").Activate
Cells.Clear
With ActiveSheet.QueryTables.Add(Connection:= _
"URL;
http://in.finance.yahoo.com/q/hp?s=" & symbol &
"&a=00&b=1&c=2006&d=" & endmonth & "&e=" & enddate & "&f=2006&g=d" _
, Destination:=Range("A1"))
.Name = "hp?s=" & symbol & "&a=00&b=1&c=2006&d=" & endmonth & "&e="
& enddate & "&f=2006&g=w_3"
.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 = "27"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
Range("a1").End(xlDown).Clear
Range(Range("a1"), Range("a1").End(xlDown).End(xlToRight)).Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess
Range("k1") = symbol
Range("K1").Font.Bold = True
'++++++++++++++
Range("a1").Select
Dim cfind As Range
With Range(Range("G1"), Cells(Rows.Count, "g").End(xlUp))
Set cfind = .Find(what:="")
If Not cfind Is Nothing Then ActiveCell.EntireRow.Delete
End With
Range("A1").Select
charting
Application.DisplayAlerts = True
End Sub
================================
Sub charting()
Dim low1, low2, high1, high2, vol1, vol2, date1, date2 As Range
Dim low, high, vol, ddate As Range
Worksheets("sheet1").Activate
Set low1 = Cells.Find("Low").Offset(1, 0)
Set low2 = low1.End(xlDown)
Set high1 = Cells.Find("High").Offset(1, 0)
Set high2 = high1.End(xlDown)
Set vol1 = Cells.Find("volume").Offset(1, 0)
Set vol2 = vol1.End(xlDown)
Set date1 = Cells.Find("date").Offset(1, 0)
Set date2 = date1.End(xlDown)
Set llow = Range(low1, low2)
Set hhigh = Range(high1, high2)
Set vol = Range(vol1, vol2)
Set ddate = Range(date1, date2)
' Range(Range("B1"), Range("B1").Offset(0, 3)).Select
' Range(Selection, Selection.End(xlDown)).Select
'On Error Resume Next
'Sheets("daily chart").Delete
Charts.Add
ActiveChart.ChartType = xlLineMarkers
ActiveChart.Name = "daily chart"
ActiveChart.SeriesCollection(1).Values = llow
ActiveChart.SeriesCollection(1).Name = "low"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(2).Values = hhigh
ActiveChart.SeriesCollection(2).Name = "high"
ActiveChart.SeriesCollection.NewSeries
ActiveChart.SeriesCollection(3).Values = vol
ActiveChart.SeriesCollection(3).Name = "volume"
ActiveChart.SeriesCollection(1).XValues = _
ddate
ActiveChart.SeriesCollection(2).XValues = _
ddate
ActiveChart.SeriesCollection(3).XValues = _
ddate
ActiveChart.SeriesCollection(3).Select
ActiveChart.SeriesCollection(3).AxisGroup = 2
With ActiveChart
.HasTitle = True
.ChartTitle.Characters.Text = "DAILY DATA FOR " &
Worksheets("sheet1").Range("K1").Value
.Axes(xlCategory, xlPrimary).HasTitle = True
.Axes(xlCategory, xlPrimary).AxisTitle.Characters.Text = "DATE"
.Axes(xlValue, xlPrimary).HasTitle = True
.Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = "PRICE"
End With
ActiveChart.Axes(xlValue).Select
With ActiveChart.Axes(xlValue)
.MinimumScale =
WorksheetFunction.RoundDown((WorksheetFunction.Min(llow)), -1)
.MaximumScaleIsAuto = True
.MinorUnitIsAuto = True
.MajorUnitIsAuto = True
.Crosses = xlAutomatic
.ReversePlotOrder = False
.ScaleType = xlLinear
.DisplayUnit = xlNone
End With
Application.DisplayAlerts = True
End Sub
=======================================
"Aashish.Shukla"