Help: Dynamically Formatting Line Graph
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!
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
Reply With Quote
