Thursday, July 17, 2014

Option Explicit 'all variables needed to be defined before used
Option Base 1 'index starts from 1 if not explicitly set

'main entry
Public Sub Main()
    Call PasteData
    Call VisData
    Call RetData
End Sub
'This subroutine will read data from another csv file.
'Meanwhile, the data will be cleansed.
'The data will be returned in a two dimensional array.
Private Function ImportData() As Variant
    Dim FilePath As String 'file path as string
    Dim FileObj As Object 'file systemt object
    Dim Fs As Variant 'files stream to read and write data
    Dim Data2D() As Variant 'data vector as 2 dimension array
    Dim TmpData() As Variant 'tempary data container
    Dim Rows As Integer 'num of rows
    Dim Cols As Integer 'num of columns
    Dim LineCount As Integer 'number of lines in the data file
    Dim i As Integer 'index
    Dim j As Integer 'index
   
    FilePath = ThisWorkbook.Path & "\data.csv" 'absolute path for the data file
    Set FileObj = CreateObject("Scripting.FileSystemObject") 'create new file object
    Set Fs = FileObj.opentextfile(FilePath) 'create new file stream to read data from csv file
   
    LineCount = 0
    Do While Not Fs.atendofstream
        LineCount = LineCount + 1 'increate the line number by one if it is not the end of the file
        ReDim Preserve TmpData(1 To LineCount) 're define the variable to hold more data
        TmpData(LineCount) = Split(Fs.readline, ",") 'split each line from data file and store in two dimension array
       
        'this if clause will replace the N/A data with its previous value
        If CStr(TmpData(LineCount)(1)) = "#N/A" Then
            TmpData(LineCount)(1) = TmpData(LineCount - 1)(1)
        End If
    Loop
    Fs.Close 'close the data stream
   
    Cols = UBound(TmpData(1)) + 1
    ReDim Data2D(1 To LineCount, 1 To Cols)
    'iterate to convert into normal 2 dimension data
    For i = 1 To LineCount
        For j = 1 To Cols
            Data2D(i, j) = TmpData(i)(j - 1)
        Next j
    Next i
   
    ImportData = Data2D 'return data
End Function

'This subroutine will paste the data into a new sheet within this workbook
Public Sub PasteData()
    Dim Data2D() As Variant 'array to hold the data, don't need to specify size of the array
    Dim Rows As Integer 'number of lines in the data
    Dim Cols As Integer 'number of columns in the data
    Dim SheetName As String 'sheet name
    Dim i As Integer 'index variable
    Dim j As Integer 'index variable
   
    SheetName = "ExoticData"
    Data2D = ImportData() 'import data
    Rows = UBound(Data2D, 1) 'get number of rows
    Cols = UBound(Data2D, 2) 'get number of columns
   
    AddWorkSheet (SheetName) 'create a new sheet
   
    'paste the data into a new sheet
    For i = 1 To Rows
        For j = 1 To Cols
            ThisWorkbook.Sheets(SheetName).Cells(i, j) = Data2D(i, j)
        Next j
    Next i
End Sub

'This sub will visualize the data, including plot
Public Sub VisData()
    Dim ChartSheetName As String 'chart sheet name
    Dim ChartSheet As Variant 'chart object
    Dim ts As Series 'series collection
    Dim ts2 As Series
    Dim Time() As Date 'date series
    Dim Price() As Double 'price series
    Dim Data2D() As Variant '2d data
    Dim Rows As Integer
    Dim Cols As Integer
   
    Dim i As Integer 'index
    Dim j As Integer 'index
   
    Data2D = ImportData()
    Rows = UBound(Data2D)
    Cols = UBound(Data2D, 2)
    ReDim Time(1 To Rows - 1)
    ReDim Price(1 To Rows - 1)
    ReDim Ret(1 To Rows - 1)
    For i = 2 To Rows
        Time(i - 1) = CDate(Data2D(i, 1))
        Price(i - 1) = Data2D(i, 2)
    Next i
   
    ChartSheetName = "PriceChart"
    Application.DisplayAlerts = False 'turn off the error alert
    On Error Resume Next 'continue to next line if there is error
    ThisWorkbook.Sheets(ChartSheetName).Delete 'delete the existing chart sheet with given name
    Err.Clear 'clear the error object
   
   Set ChartSheet = ThisWorkbook.Charts.Add(after:=Sheets("ExoticData"))   'ChartSheetName ' add a new chart sheet with given name
   
    With ChartSheet
        .Name = ChartSheetName
        .ChartType = xlLine
        .HasTitle = True
        .ChartTitle.Text = "Stock Price"
        .after = ThisWorkbook.Sheets("ExoticData")
       
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Caption = "Time"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Caption = "Price"
    End With
   
    Rows = Sheets("ExoticData").UsedRange.Rows.count
   
    For Each ts In ChartSheet.SeriesCollection
        ts.Delete
    Next
    Set ts = ChartSheet.SeriesCollection.NewSeries
    With ts
        .XValues = ThisWorkbook.Sheets("ExoticData").Range("a2:a" & Rows)
        .Values = ThisWorkbook.Sheets("ExoticData").Range("b2:b" & Rows)
    End With
   
    Set ts2 = ChartSheet.SeriesCollection.NewSeries
    With ts2
        .XValues = ThisWorkbook.Sheets("ExoticData").Range("a2:a" & Rows)
        .Values = ThisWorkbook.Sheets("ExoticData").Range("c2:c" & Rows)
    End With
   
    Application.DisplayAlerts = True 'turn on error alert
End Sub
Public Sub RetData()
    Dim Data2D() As Variant 'data array
    Dim Rows As Integer 'num of rows
    Dim Cols As Integer 'num of columns
    Dim i As Integer 'index
    Dim Ret() As Double 'return of stock price
    Dim Price() As Double
    Dim Time() As Date
    Dim SheetName As String: SheetName = "ReturnSheet"
    Dim ChartName As String: ChartName = "RetChart"
    Dim RetChart As Variant 'return chart sheet
    Dim ts As Series 'data series
   
    Data2D = ImportData()
    Rows = UBound(Data2D, 1)
    Cols = UBound(Data2D, 2)
    ReDim Ret(1 To Rows - 2)
    ReDim Price(1 To Rows)
    ReDim Time(1 To Rows - 2)
   
    Call AddWorkSheet(SheetName) 'add a new sheet for return data
    ThisWorkbook.Sheets(SheetName).Range("a1") = Data2D(1, 1) 'set up time title
    ThisWorkbook.Sheets(SheetName).Range("b1") = "Return" 'set up return title
    On Error GoTo 0
    On Error GoTo NoSheetHandler 'go to error handler if not sheet exits
    ThisWorkbook.Sheets(SheetName).Move after:=ThisWorkbook.Sheets("PriceChart")     'move the sheet
   
    For i = 2 To Rows - 1
        Ret(i - 1) = Application.WorksheetFunction.Ln(Data2D(i + 1, 2)) _
        - Application.WorksheetFunction.Ln(Data2D(i, 2)) ' calcualte log return of stock price
        ThisWorkbook.Sheets(SheetName).Range("a" & i) = Data2D(i, 1) 'paste time data
        ThisWorkbook.Sheets(SheetName).Range("b" & i) = Ret(i - 1) 'paste return data
        Time(i - 1) = CDate(Data2D(i, 1))
    Next i
   
    On Error GoTo 0
    On Error Resume Next
    Application.DisplayAlerts = False
    ThisWorkbook.Sheets(ChartName).Delete 'delete old chart with given name if exist
   
    Set RetChart = ThisWorkbook.Charts.Add 'add a new return chart
    ThisWorkbook.Sheets(ChartName).Move after:=ThisWorkbook.Sheets(SheetName)
   
    With RetChart
        .ChartType = xlLine
        .Name = ChartName
        .HasTitle = True
        .ChartTitle.Text = "Return of Stock"
        .Axes(xlCategory, xlPrimary).HasTitle = True
        .Axes(xlCategory, xlPrimary).AxisTitle.Caption = "Time"
        .Axes(xlValue, xlPrimary).HasTitle = True
        .Axes(xlValue, xlPrimary).AxisTitle.Caption = "Return"
       
        For Each ts In .SeriesCollection
            ts.Delete
        Next
        Set ts = .SeriesCollection.NewSeries
        With ts
            .XValues = Time
            .Values = Ret
        End With
    End With
    Application.DisplayAlerts = True
    Exit Sub 'exit sub to avoid error handler
   
NoSheetHandler:
     MsgBox ("no sheet is there")
     Err.Clear

End Sub
'This sub will add a new sheet to the work book with the given sheet name
Private Sub AddWorkSheet(SheetName)
    Application.DisplayAlerts = False 'disable the error alert
    On Error GoTo 0
    On Error Resume Next 'if there is an error, continue to the next line
    ThisWorkbook.Worksheets(SheetName).Delete 'delete a sheet with the given name
    Err.Clear 'there will be a system error if a sheet with the given name does not exist, this line will clear that error
   
    Application.DisplayAlerts = True 'turn on the error alerting
    ThisWorkbook.Worksheets.Add.Name = SheetName 'add a new sheet with the given name
End Sub