PDA

View Full Version : Asking about Using VBA in Excel for Download Financial Data



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, 07:05 PM
Thank you very much.

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.