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