HTML Code:
Sub CallPerformanceFormat()
Call PerformanceHistoryFormatting
Call TextWrap
Call TotalReturnFmt
Call Pctge
Call AddLineGraph
End Sub
Sub PerformanceHistoryFormatting()
Sheets("Sheet2").Select
Range("A2").Select
ActiveCell.FormulaR1C1 = "Date"
With Selection
.HorizontalAlignment = xlLeft
End With
Sheets("Sheet1").Select
Dim rng As Range, cell As Range, del As Range
Set rng = Intersect(Range("A1:A6"), ActiveSheet.UsedRange)
Application.ScreenUpdating = False
For Each cell In rng
If (cell.Value) Like "PERFORMANCE HISTORY" Then
Set del = cell
del.Offset(12, 2).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Sheet2").Select
Range("A3").Select
ActiveSheet.Paste
End If
Next cell
'Name of Portfolio
Sheets("Sheet1").Select
Set rng = Intersect(Range("A:A"), ActiveSheet.UsedRange)
For Each cell In rng
If (cell.Value) Like "PERFORMANCE HISTORY" Then
Set del = cell
del.Offset(2, 0).Select
Selection.Copy
Sheets("Sheet2").Select
Range("IV2").Select
Selection.End(xlToLeft).Offset(0, 1).Select
ActiveSheet.Paste
Selection.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=RC[-1]&"" Index"""
End If
Sheets("Sheet1").Select
Next cell
'Pull Performance
Sheets("Sheet1").Select
Set rng = Intersect(Range("A:A"), ActiveSheet.UsedRange)
For Each cell In rng
If (cell.Value) Like "PERFORMANCE HISTORY" Then
Set del = cell
del.Offset(13, 3).Select
Range(Selection, Selection.Offset(0, 1)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Sheet2").Select
Range("IV4").Select
Selection.End(xlToLeft).Offset(0, 1).Select
ActiveSheet.Paste
Range("IV4").Select
Selection.End(xlToLeft).Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=RC[-2]/100"
Selection.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=RC[-2]/100"
ActiveCell.Offset(0, -2).Select
Range(Selection, Selection.End(xlDown)).Offset(0, 1).Select
Range(Selection, Selection.Offset(0, 1)).Select
Selection.FillDown
Selection.Copy
Selection.Offset(0, -2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.NumberFormat = "0.00000%"
Selection.Offset(0, 2).Select
Selection.ClearContents
End If
Sheets("Sheet1").Select
Next cell
'Format Dates
Sheets("Sheet2").Select
Columns("A:A").Select
Selection.NumberFormat = "mm/dd/yy"
Selection.Font.Bold = True
'Enter Formulas for Monthly Returns
With Worksheets("Sheet2")
With Range("A2").End(xlDown).Offset(2, 0)
.Value = "Total"
.Offset(1, 0).Value = "Annlzd."
.Offset(2, 0).Value = "Std. Dev."
.Offset(0, 1).FormulaArray = "=PRODUCT(1+R4C:R[-2]C)-1"
.Offset(1, 1).FormulaR1C1 = "=((1+R[-1]C)^(12/COUNT(R4C:R[-3]C)))-1"
.Offset(2, 1).FormulaR1C1 = "=(STDEV.P(R4C:R[-4]C)*SQRT(12))"
End With
Range("B4").End(xlDown).Select
Range(Selection, Selection.End(xlToRight)).Offset(2, 0).Select
Selection.FillRight
Selection.Offset(1, 0).Select
Selection.FillRight
Selection.Offset(1, 0).Select
Selection.FillRight
End With
'Growth of $100
Sheets("Sheet2").Select
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Range("A2").End(xlToRight).Offset(0, 2).Select
ActiveSheet.Paste
Range("B2").Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Range("A2").End(xlToRight).Offset(0, 3).Select
ActiveSheet.Paste
Range("A2").End(xlToRight).Offset(1, 3).Select
ActiveCell.FormulaR1C1 = "=1.000000"
Range("A2").End(xlToRight).Offset(1, 3).Select
ActiveCell.FormulaR1C1 = "=100.000"
Range("A2").End(xlToRight).Offset(2, 3).Select
ActiveCell.FormulaR1C1 = "=R[-1]C*(1+RC[-4])"
Range("A2").End(xlToRight).Offset(2, 2).Select
Range(Selection, Selection.End(xlDown)).Offset(0, 1).Select
Selection.FillDown
Range("A2").End(xlToRight).Offset(0, 3).Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Offset(1, 0).Select
Selection.FillRight
Selection.NumberFormat = "0.00000"
With Selection
.HorizontalAlignment = xlRight
Cells.Select
End With
End Sub
Sub TextWrap()
Rows("2:2").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = True
Range("A:A").Select
Selection.End(xlDown).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.Font.Bold = True
End Sub
Sub TotalReturnFmt()
Range("IV3").Select
Selection.End(xlToLeft).Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=((RC[-2]-100)/100)"
Selection.Offset(0, 1).Select
ActiveCell.FormulaR1C1 = "=((RC[-2]-100)/100)"
ActiveCell.Offset(0, -2).Select
Range(Selection, Selection.End(xlDown)).Offset(0, 1).Select
Range(Selection, Selection.Offset(0, 1)).Select
Selection.FillDown
Selection.Copy
Selection.Offset(0, -2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.NumberFormat = "0.00000%"
Selection.Offset(0, 2).Select
Selection.ClearContents
End Sub
Sub Pctge()
Sheets("Sheet2").Select
'
Columns("B:C").Select
Selection.Style = "Percent"
Selection.NumberFormat = "0.000%"
Columns("F:G").Select
Selection.Style = "Percent"
Selection.NumberFormat = "0.000%"
End Sub
Sub AddLineGraph()
Dim LastRow As Long
With Sheets("Sheet2")
LastRow = .Range("G" & Rows.Count).End(xlUp).Row
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLine
ActiveChart.SetSourceData Source:=.Range("E2:G" & LastRow)
End With
ActiveChart.Legend.Select
Selection.Position = xlBottom
ActiveChart.Axes(xlValue).Select
Selection.TickLabels.NumberFormat = "0%"
ActiveChart.Axes(xlCategory).Select
Selection.TickLabels.NumberFormat = "[$-409]mmm-yy;@"
Selection.TickLabelPosition = xlLow
ActiveChart.Axes(xlCategory).AxisBetweenCategories = False
ActiveChart.SeriesCollection(1).Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(0, 0, 102)
.Transparency = 0
End With
ActiveChart.SeriesCollection(2).Select
With Selection.Format.Line
.Visible = msoTrue
.ForeColor.RGB = RGB(192, 0, 0)
.Transparency = 0
End With
End Sub