Option Explicit
Private Sub test_portfolio()
Application.DisplayAlerts = False
On Error Resume Next
Workbooks("table.csv").Close
Workbooks("Part3.xlsm").Activate
Dim Symbol As String
Dim StartDate As Date
Dim EndDate As Date
Dim StartDay As Integer
Dim StartMonth As Integer
Dim StartYear As Integer
Dim EndDay As Integer
Dim EndMonth As Integer
Dim tempdateval As Date
Dim previousclosingrate As Date
Dim EndYear As Integer
Dim closingrate As Double
Dim URL As String
Dim temppos As String
Sheets("Portfolio").Select
Range("A2").Select
temppos = Replace(ActiveCell.Address, "$", "")
Range(temppos).Select
While ActiveCell.Value <> ""
temppos = Replace(ActiveCell.Address, "$", "")
tempdateval = CDate(ActiveCell.Offset(0, 3).Value)
Symbol = ActiveCell.Value
ActiveCell.Offset(0, 3).Select
StartDate = CDate(ActiveCell.Value)
EndDate = CDate(ActiveCell.Value)
On Error GoTo 0
'StartDate = CDate(StartDate - 1)
StartDay = Day(StartDate)
StartMonth = Month(StartDate) - 1
StartYear = Year(StartDate)
EndDay = Day(EndDate)
EndMonth = Month(EndDate) - 1
EndYear = Year(EndDate)
URL = "http://real-chart.finance.yahoo.com/table.csv?s=" _
& Symbol & "&d=" & EndMonth & "&e=" & EndDay & "&f=" & EndYear _
& "&g=d&a=" & StartMonth & "&b=" & StartDay & "&c=" _
& StartYear & "&ignore=.csv"
' MsgBox URL
On Error Resume Next
Workbooks.Open (URL)
If Err.Number <> 0 Then
GoTo comingback
Else
Cells(1, 1).CurrentRegion.Copy
'Workbooks("Assets.xlsm").Activate
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = Symbol
ActiveSheet.Paste
Columns(1).AutoFit
Application.CutCopyMode = False
Workbooks("table.csv").Activate
Range("E2").Select
Selection.Copy
Workbooks("Part3.xlsm").Activate
Sheets("Portfolio").Select
Range(temppos).Select
ActiveCell.Offset(0, 4).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
closingrate = CDbl(ActiveCell.Value)
ActiveCell.Value = 1
ActiveCell.Value = closingrate * (ActiveCell.Offset(0, -2).Value)
ActiveCell.Select
Selection.NumberFormat = "0.00;[Red]0.00"
Workbooks("table.csv").Activate
On Error Resume Next
ActiveWorkbook.Close
End If
Call lastclosingrate(temppos, closingrate)
comingback:
Workbooks("Part3.xlsm").Activate
Range(temppos).Select
ActiveCell.Offset(1, 0).Select
temppos = Replace(ActiveCell.Address, "$", "")
Wend
Application.DisplayAlerts = True
End Sub
Sub lastclosingrate(ByVal temppos As String, ByVal closingratefirst As Double)
On Error Resume Next
Workbooks("table.csv").Close
Workbooks("Part3.xlsm").Activate
Dim Symbol As String
Dim StartDate As Date
Dim EndDate As Date
Dim StartDay As Integer
Dim StartMonth As Integer
Dim StartYear As Integer
Dim EndDay As Integer
Dim EndMonth As Integer
Dim tempdateval As Date
Dim previousclosingrate As Date
Dim EndYear As Integer
Dim closingratesecond As Double
Dim URL As String
'Dim temppos As String
Sheets("Portfolio").Select
Range(temppos).Select
tempdateval = CDate(ActiveCell.Offset(0, 3).Value)
Symbol = ActiveCell.Value
ActiveCell.Offset(0, 3).Select
StartDate = CDate(ActiveCell.Value) - 1
EndDate = CDate(ActiveCell.Value) - 1
On Error GoTo 0
'StartDate = CDate(StartDate - 1)
StartDay = Day(StartDate)
StartMonth = Month(StartDate) - 1
StartYear = Year(StartDate)
EndDay = Day(EndDate)
EndMonth = Month(EndDate) - 1
EndYear = Year(EndDate)
URL = "http://real-chart.finance.yahoo.com/table.csv?s=" _
& Symbol & "&d=" & EndMonth & "&e=" & EndDay & "&f=" & EndYear _
& "&g=d&a=" & StartMonth & "&b=" & StartDay & "&c=" _
& StartYear & "&ignore=.csv"
' MsgBox UR
Workbooks.Open (URL)
If Err.Number <> 0 Then
GoTo comingback
Else
Cells(1, 1).CurrentRegion.Copy
'Workbooks("Assets.xlsm").Activate
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = Symbol
ActiveSheet.Paste
Columns(1).AutoFit
Application.CutCopyMode = False
Workbooks("table.csv").Activate
Range("E2").Select
closingratesecond = CDbl(ActiveCell.Value)
Selection.Copy
Workbooks("Part3.xlsm").Activate
Sheets("Portfolio").Select
Range(temppos).Select
ActiveCell.Offset(0, 5).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
If closingratefirst <> 0 And closingratesecond <> 0 Then
ActiveCell.Value = (closingratefirst / closingratesecond)
Else
ActiveCell.Value = "Not available"
End If
ActiveCell.Select
Selection.NumberFormat = "0.00;[Red]0.00"
Workbooks("table.csv").Activate
On Error Resume Next
ActiveWorkbook.Close
End If
comingback:
Workbooks("Part3.xlsm").Activate
Range(temppos).Select
End Sub
No comments:
Post a Comment