PDA

View Full Version : Help: Dynamically Formatting Line Graph



zljordan
08-20-2013, 08:51 AM
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

zljordan
08-20-2013, 09:06 AM
Apologies for double posting. Here is the attached workbook.

Thank you.