vinhp2013
04-29-2013, 08:18 PM
In my attached excel file that I get from the website of investexcel and it can do: Download all financial data with symbols from Cells A11 (Worksheet: Parameters) to last row of column A. The results that each symbol data is copied to new sheet with sheet name is the symbol name. With n symbols, we have n new sheets.
I have a situation. I want to download n symbol data to only one new sheet. The 1st symbol data is in Cell A1, Sheet DATA. The 2nd symbol data is in Cell H1, Sheet DATA ....
If you know to modify this code. Please, help me as soon as possible.
Thank you.
Bob Phillips
05-01-2013, 01:19 AM
'http://investexcel.net
Sub DownloadData()
Dim ws As Worksheet
Dim StockTicker As String
Dim frequency As String
Dim numRows As Long
Dim lastrow As Long
Dim datacol As Long
Application.ScreenUpdating = False
lastrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
frequency = Worksheets("Parameters").Range("B7")
'Delete all sheets apart from Parameters sheet
Application.DisplayAlerts = False
For Each ws In Worksheets
If ws.Name <> "Parameters" Then ws.Delete
Next
Application.DisplayAlerts = True
'Add DATA worksheet
Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
ws.Name = "DATA"
'Loop through all tickers
With Worksheets("Parameters")
datacol = 1
For ticker = 11 To lastrow
StockTicker = .Range("$A$" & ticker)
If StockTicker <> "" Then
Cells(1, datacol) = "Stock Quotes for " & StockTicker
Call DownloadStockQuotes(StockTicker:=StockTicker, _
StartDate:=.Range("$B$5"), _
EndDate:=.Range("$B$6"), _
DestinationCell:=ws.Cells(2, datacol), _
freq:=frequency)
ws.Columns(datacol).TextToColumns Destination:=ws.Cells(1, datacol), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, _
Tab:=True, Semicolon:=False, Comma:=True, Space:=False, Other:=False, _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1))
ws.Cells(2, datacol).Resize(lastrow, 7).Sort Key1:=ws.Cells(2, datacol), _
Order1:=xlDescending, _
Header:=xlYes
ws.Columns(datacol).Resize(, 7).ColumnWidth = 10
End If
datacol = datacol + 7
Next ticker
End With
If Sheets("Parameters").Range("exportToCSV") Then
On Error GoTo ErrorHandler:
Call CopyToCSV
End If
ErrorHandler:
Worksheets("Parameters").Select
Application.ScreenUpdating = True
End Sub
Sub DownloadStockQuotes( _
ByVal StockTicker As String, _
ByVal StartDate As Date, _
ByVal EndDate As Date, _
ByVal DestinationCell As Range, _
ByVal freq As String)
Dim qurl As String
Dim StartMonth, StartDay, StartYear, EndMonth, EndDay, EndYear As String
StartMonth = Format(Month(StartDate) - 1, "00")
StartDay = Format(Day(StartDate), "00")
StartYear = Format(Year(StartDate), "00")
EndMonth = Format(Month(EndDate) - 1, "00")
EndDay = Format(Day(EndDate), "00")
EndYear = Format(Year(EndDate), "00")
qurl = "URL;http://table.finance.yahoo.com/table.csv?s=" + StockTicker + "&a=" + StartMonth + "&b=" + StartDay + "&c=" + StartYear + "&d=" + EndMonth + "&e=" + EndDay + "&f=" + EndYear + "&g=" + freq + "&ignore=.csv"
On Error GoTo ErrorHandler:
With ActiveSheet.QueryTables.Add(Connection:=qurl, Destination:=DestinationCell)
.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 = "20"
.WebPreFormattedTextToColumns = True
.WebConsecutiveDelimitersAsOne = True
.WebSingleBlockTextImport = False
.WebDisableDateRecognition = False
.WebDisableRedirections = False
.Refresh BackgroundQuery:=False
End With
ErrorHandler:
End Sub
Sub CopyToCSV()
Dim ws As Worksheet
Dim myPath As String
Dim myFileName As String
Dim frequency As String
Dim dateFrom As Date
Dim dateTo As Date
Dim lastrow As Long
Dim lastcol As Long
Dim i As Long
Set ws = Worksheets.Add(after:=Worksheets(Worksheets.Count))
With Worksheets("Parameters")
dateFrom = .Range("$B$5")
dateTo = .Range("$B$6")
frequency = .Range("$B$7")
End With
myPath = "c:\temp\"
If Not Right(myPath, 1) = "\" Then myPath = myPath & "\"
With Worksheets("DATA")
lastcol = .Cells(2, .Columns.Count).End(xlToLeft).Column
For i = 1 To lastcol Step 7
lastrow = .Cells(.Rows.Count, i).End(xlUp).Row
ticker = Replace(.Cells(1, i).Value, "Stock Quotes for ", "")
myFileName = ticker & " " & Format(dateFrom, "dd-mm-yyyy") & " - " & Format(dateTo, "dd-mm-yyyy") & " " & frequency
If Not Right(myFileName, 4) = ".csv" Then myFileName = myFileName & ".csv"
.Cells(1, i).Resize(lastrow, 7).Copy ws.Range("A1")
ws.Copy
With ActiveWorkbook
.SaveAs Filename:=myPath & myFileName, _
FileFormat:=xlCSV, _
CreateBackup:=False
.Close False
End With
ws.UsedRange.ClearContents
End If
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
Next
End Sub
vinhp2013
05-02-2013, 08:57 PM
I want to modify the VBA code as follows:
Don't create new DATA sheet, and delete all sheets without "Parameters" Sheet. It can download data into DATA sheet that created before. Data downloaded into DATA with format as follows: Stock Data is in 3rd row of the DATA sheet.
Please once time, help me.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.