Help: Dynamically Formatting Line Graph

[zljordan]

Good day to everyone-
As a newcomer to VBA, and I'm trying to come up with a more efficient solution to the Macro in which I am currently using. This macro takes performance data which has been dumped into excel, and creates a standardized line graph from it, as well as addresses some other formatting issues. I have attached a workbook which displays the correct/standardized manner in which I would like to format the graph (Sheet1), as well as the graph my macro creates (Sheet2).

Also, if anyone has any tips or suggestions on ways to more efficiently create the below code, it would be sincerely appreciated.

Thank you!




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