Experts help required to shorten and concise VBA macro

N

norulen

Active Member
Joined
Nov 30, 2012
Messages
389
Hi Experts,

I have written a VBA macro to compute returns of my different investment portfolio, which works perfectly fine and serves my purpose pretty well. But my VBA skills are at a very very amatuer level. Seeking your expertise and help to shorten & concise this macro. It should be good learning as well help for me. Thanks in advance.

Here is the macro written:
Code: 
'Macro for computing Individual Portfolio returns
    ''Select and copy the data to be used
    Sheets("Holding Details").Select
    Range("F:F,G:G,I:I").Select
    Selection.Copy
    ''Paste the data selected
    Sheets("XIRR Calculator").Select
    Range("M1").Select
    ActiveSheet.Paste
    ''Multiply the values to be read as outflow of money
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "-1"
    ActiveCell.Copy
    Range("O2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlMultiply, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ''Capture todays date
    Range("N" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.FormulaR1C1 = "=TODAY()"
    Range("N" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.FormulaR1C1 = "=TODAY()"
    Range("N" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.FormulaR1C1 = "=TODAY()"
    Range("N" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.FormulaR1C1 = "=TODAY()"
    Range("N" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.FormulaR1C1 = "=TODAY()"
    Range("N" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.FormulaR1C1 = "=TODAY()"
    ''Capture current value of investement
    Range("O" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.FormulaR1C1 = Sheets("Returns Summary Sheet").Range("D2")
    Range("O" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.FormulaR1C1 = Sheets("Returns Summary Sheet").Range("D3")
    Range("O" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.FormulaR1C1 = Sheets("Returns Summary Sheet").Range("D4")
    Range("O" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.FormulaR1C1 = Sheets("Returns Summary Sheet").Range("D5")
    Range("O" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.FormulaR1C1 = Sheets("Returns Summary Sheet").Range("D6")
    Range("O" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.FormulaR1C1 = Sheets("Returns Summary Sheet").Range("D9")
    ''Capture Equity and Debt labels against current value of investement
    Range("M" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.FormulaR1C1 = "Beginner"
    Range("M" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.FormulaR1C1 = "Safe player"
    Range("M" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.FormulaR1C1 = "Ultracool"
    Range("M" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.FormulaR1C1 = "Adventurer"
    Range("M" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.FormulaR1C1 = "Others"
    Range("M" & Rows.Count).End(xlUp).Offset(1).Select
    ActiveCell.FormulaR1C1 = "Fixed guns"
    ''Apply Filter on the range selected
    Range("M1:O1").Select
    Selection.AutoFilter
    ''Sort the data according to date
    ActiveWorkbook.Worksheets("XIRR Calculator").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("XIRR Calculator").AutoFilter.Sort.SortFields.Add Key _
        :=Range("N1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("XIRR Calculator").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ''Sort the data according to portfolio
    ActiveWorkbook.Worksheets("XIRR Calculator").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("XIRR Calculator").AutoFilter.Sort.SortFields.Add Key _
        :=Range("M1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("XIRR Calculator").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ''Clear Auto Filter
    ActiveSheet.AutoFilterMode = False
    ''Compute XIRR of the investment
    Range("P2").Select
    ActiveCell.FormulaArray = "=IF(RC[-3]=R[-1]C[-3],"""",XIRR(IF(RC[-3]:R[4997]C[-3]=RC[-3],RC[-1]:R[4997]C[-1],0),RC[-2]:R[4997]C[-2]))"
    Range("O" & Rows.Count).End(xlUp).Offset(0, 1).Select
    ActiveCell.FormulaR1C1 = "A"
    Range("P2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.FillDown
 
Last edited:

Excel Facts

Spell Check in Excel
Press F7 to start spell check in Excel. Be careful, by default, Excel does not check Capitalized Werds (whoops)
Sort by date Sort by votes
Hello Norulen,

With VBA, you almost never have to use the .Select method. You can just reference the range you wish to work with. For example, the block of code below:

Code: 
 ''Capture todays date
 Range("N" & Rows.Count).End(xlUp).Offset(1).Select
 ActiveCell.FormulaR1C1 = "=TODAY()"
 Range("N" & Rows.Count).End(xlUp).Offset(1).Select
 ActiveCell.FormulaR1C1 = "=TODAY()"
 Range("N" & Rows.Count).End(xlUp).Offset(1).Select
 ActiveCell.FormulaR1C1 = "=TODAY()"
 Range("N" & Rows.Count).End(xlUp).Offset(1).Select
 ActiveCell.FormulaR1C1 = "=TODAY()"
 Range("N" & Rows.Count).End(xlUp).Offset(1).Select
 ActiveCell.FormulaR1C1 = "=TODAY()"
 Range("N" & Rows.Count).End(xlUp).Offset(1).Select
 ActiveCell.FormulaR1C1 = "=TODAY()"

Would be shortened to this:
Code: 
 Range("N" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = "=TODAY()"
 Range("N" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = "=TODAY()"
 Range("N" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = "=TODAY()"
 Range("N" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = "=TODAY()"
 Range("N" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = "=TODAY()"
 Range("N" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = "=TODAY()"

However, this can be further improved on:
Code: 
'Lastrow = Range("N" & Rows.Count).End(xlUp).Offset(1, 0).Row
'Range("N" & Lastrow, "N" & Lastrow + 5).Formula = "=Today()"

and if you really want to, you can get it down to 1 line:
Code: 
Range("N" & Range("N" & Rows.Count).End(xlUp).Offset(1, 0).Row, "N" & Range("N" & Rows.Count).End(xlUp).Offset(1, 0).Row + 5).Formula = "=Today()"


So do you want to have a go are removing all the .SELECT bits of your code. i can then help show you how to make the rest of it more concise (as shown in the example above).

Regards
Caleeco
 
Upvote 0
Hi Caleeco,

First all thanks a ton for taking time out to read such a long code.

Picked up some very useful tips from your explanation. These would really help me for not only keeping this code concise but also all the other future codes that I wish to write.

Here is the modified version based on your suggestion. Waiting for your advice & suggestion to further trim it down (if possible) :)

Code: 
'Individual Portfolio returns
    ''Copy and paste the data to be used
    Sheets("Holding Details").Range("F:F,G:G,I:I").Copy Destination:=Sheets("XIRR Calculator").Range("M1")
    ''Multiply the values to be read as outflow of money. D1 contains value of -1
    Sheets("XIRR Calculator").Range("D1").Copy
    Range(Range("O2"), Range("O2").End(xlDown)).PasteSpecial Paste:=xlPasteValues, Operation:=xlMultiply, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ''Capture todays date
    Range("N" & Range("N" & Rows.Count).End(xlUp).Offset(1, 0).Row, "N" & Range("N" & Rows.Count).End(xlUp).Offset(1, 0).Row + 5).Formula = "=Today()"
    ''Capture current value of investement
    Range("O" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = Sheets("Returns Summary Sheet").Range("D2")
    Range("O" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = Sheets("Returns Summary Sheet").Range("D3")
    Range("O" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = Sheets("Returns Summary Sheet").Range("D4")
    Range("O" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = Sheets("Returns Summary Sheet").Range("D5")
    Range("O" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = Sheets("Returns Summary Sheet").Range("D6")
    Range("O" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = Sheets("Returns Summary Sheet").Range("D9")
    ''Capture Equity and Debt labels against current value of investement
    Range("M" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = "Beginner"
    Range("M" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = "Safe player"
    Range("M" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = "Ultracool"
    Range("M" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = "Adventurer"
    Range("M" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = "Others"
    Range("M" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = "Fixed guns"
    ''Apply Filter on the range selected
    Range("M1:O1").AutoFilter
    ''Sort the data according to date
    ActiveWorkbook.Worksheets("XIRR Calculator").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("XIRR Calculator").AutoFilter.Sort.SortFields.Add Key _
        :=Range("N1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("XIRR Calculator").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ''Sort the data according to portfolio
    ActiveWorkbook.Worksheets("XIRR Calculator").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("XIRR Calculator").AutoFilter.Sort.SortFields.Add Key _
        :=Range("M1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("XIRR Calculator").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ''Clear Auto Filter
    ActiveSheet.AutoFilterMode = False
    ''Compute XIRR of the investment
    Range("P2").FormulaArray = "=IF(RC[-3]=R[-1]C[-3],"""",XIRR(IF(RC[-3]:R[4997]C[-3]=RC[-3],RC[-1]:R[4997]C[-1],0),RC[-2]:R[4997]C[-2]))"
    Range("O" & Rows.Count).End(xlUp).Offset(0, 1).FormulaR1C1 = "A"
    Range(Range("P2"), Range("P2").End(xlDown)).FillDown
    MsgBox "RETURNS COMPUTED!"
 
Upvote 0
A couple of other things to shorten your code. You are twice processing a range of cells individually when you could populate the whole range at once.
And if you are putting "values" into a range not "formulas", why not use the "Value" property?

Each of the red sections below can be replaced with the single blue line that follows it.

Rich (BB code): 
''Capture current value of investement
Range("O" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = Sheets("Returns Summary Sheet").Range("D2")
Range("O" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = Sheets("Returns Summary Sheet").Range("D3")
Range("O" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = Sheets("Returns Summary Sheet").Range("D4")
Range("O" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = Sheets("Returns Summary Sheet").Range("D5")
Range("O" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = Sheets("Returns Summary Sheet").Range("D6")
Range("O" & Rows.Count).End(xlUp).Offset(1).Resize(5).Value = Sheets("Returns Summary Sheet").Range("D2:D6").Value

Range("O" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = Sheets("Returns Summary Sheet").Range("D9")


''Capture Equity and Debt labels against current value of investement
Range("M" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = "Beginner"
Range("M" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = "Safe player"
Range("M" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = "Ultracool"
Range("M" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = "Adventurer"
Range("M" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = "Others"
Range("M" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = "Fixed guns"

Range("M" & Rows.Count).End(xlUp).Offset(1).Resize(6).Value = _
  Application.Transpose(Array("Beginner", "Safe player", "Ultracool", "Adventurer", "Others", "Fixed guns"))
 
Last edited:
Upvote 0
Hi Caleeco,

Ignore the earlier code. I was able to cut it further down to this below code. Please have a look at it and suggest improvement.

Code: 
'Individual Portfolio returns
    ''Copy and paste the data to be used
    Sheets("Holding Details").Range("F:F,G:G,I:I").Copy Destination:=Sheets("XIRR Calculator").Range("M1")
    ''Multiply the values to be read as outflow of money
    Sheets("XIRR Calculator").Range("D1").Copy
    Range(Range("O2"), Range("O2").End(xlDown)).PasteSpecial Paste:=xlPasteValues, Operation:=xlMultiply, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    ''Capture todays date
    Range("N" & Range("N" & Rows.Count).End(xlUp).Offset(1, 0).Row, "N" & Range("N" & Rows.Count).End(xlUp).Offset(1, 0).Row + 5).Formula = "=Today()"
    ''Capture current value of investement
    Sheets("Returns Summary Sheet").Range("D2:D6,D9").Copy Destination:=Sheets("XIRR Calculator").Range("O" & Rows.Count).End(xlUp).Offset(1)
    ''Capture Equity and Debt labels against current value of investement
    Sheets("Returns Summary Sheet").Range("B2:B6,B9").Copy Destination:=Sheets("XIRR Calculator").Range("M" & Rows.Count).End(xlUp).Offset(1)
    ''Apply Filter on the range selected
    Range("M1:O1").AutoFilter
    ''Sort the data according to date
    ActiveWorkbook.Worksheets("XIRR Calculator").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("XIRR Calculator").AutoFilter.Sort.SortFields.Add Key _
        :=Range("N1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("XIRR Calculator").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ''Sort the data according to portfolio
    ActiveWorkbook.Worksheets("XIRR Calculator").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("XIRR Calculator").AutoFilter.Sort.SortFields.Add Key _
        :=Range("M1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortTextAsNumbers
    With ActiveWorkbook.Worksheets("XIRR Calculator").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ''Clear Auto Filter
    ActiveSheet.AutoFilterMode = False
    ''Compute XIRR of the investment
    Range("P2").FormulaArray = "=IF(RC[-3]=R[-1]C[-3],"""",XIRR(IF(RC[-3]:R[4997]C[-3]=RC[-3],RC[-1]:R[4997]C[-1],0),RC[-2]:R[4997]C[-2]))"
    Range("O" & Rows.Count).End(xlUp).Offset(0, 1).FormulaR1C1 = "A"
    Range(Range("P2"), Range("P2").End(xlDown)).FillDown
    MsgBox "RETURNS COMPUTED!"
 
Last edited:
Upvote 0
Thanks a lot Peter for suggestion.

I made changes to these two sections more or less in line with your recommendation.

Appreciate the help :)
 
Upvote 0
You must log in or register to reply here.

Similar threads

C
  • Question
How to get my macro to stop at the last recognized line
Replies
6
Views
273
Coco1
C
P
  • Question
Help with Vba Code
Replies
3
Views
196
Coyotex3
C
T
  • Solved
VBA Name New column & Use Column Header as Range
Replies
7
Views
553
Peter_SSs
Peter_SSs
L
  • Solved
VBA remove leading zeros
2
Replies
14
Views
1K
Joe4
Joe4
I
  • Question
Macro recorded to sort colm,n A-Z so now need to condense it
Replies
4
Views
111
Micron
M

Forum statistics

Threads
1,215,692
Messages
6,126,230
Members
449,303
Latest member
grantrob

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top