Automatting a Monthly Returns Report Using VBA in Excel

Question

I've been working at this for awhile and am running into a wall.

The Goal: Bring daily data that is automatically generated (the generation process is already working fine) and convert it to monthly and quarterly returns (other factors such as the sharpe ratio will be implemented as well) before putting the data into a report. The report will be automatically uploaded daily to a website. (Look at factshee)

The Problem: When copying the data over to the factsheet I can't get the copy & paste process to automate. The issue (I think) is that excel is viewing my blankcells as values and won't correctly identify the last cell in a column. (Look at monthly returns sheet).

My Skeleton/Steps to Automation: 1. Establish a "delete rows" column (do this to get rid of days between the first trading day and last trading day) 2. Calculate monthly returns 3. Clean up cells to prepare for pasting to factsheet/report 4. Copy and paste values

What I've Tried: 1. Here is my code to get prepared to be copy and pasted

    Sub Monthly_Returns_new_ws2()
    Range("A4:Y4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Monthly_Returns").Select
    Range("A4").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

        ' Disable certain Excel features, whilst the macro is running
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.ScreenUpdating = False

        ' Declare variables
        Dim deleteRow As Long
        Dim ws As Worksheet

        'Set objects
        Set ws = ActiveSheet

            'Loop through the rows of data, in order to delte rows with a
            'zero value in column AA. Our data commences of row 4
            For deleteRow = ws.Range("Y" & Rows.Count).End(xlUp).Row To 4 Step -1

                ' Identify values in col AA, which are zero & delete entire row
                If ws.Range("Y" & deleteRow).Value = 0 Then
                    Rows(deleteRow).EntireRow.Delete
                End If

            'Move to next cell in the range which is being looped
            Next deleteRow

        'Re-enable the above Excel features, where were disabled whilst the macro ran
        Application.Calculation = xlCalculationAutomatic
        Application.EnableEvents = True
        Application.ScreenUpdating = True
Range("AA5:BC5").Select
    Selection.AutoFill Destination:=Range("AA5:BC500"), Type:=xlFillDefault
    Range("AA5:BC500").Select
    ActiveWindow.ScrollRow = 481
    ActiveWindow.ScrollRow = 478
    ActiveWindow.ScrollRow = 473
    ActiveWindow.ScrollRow = 468
    ActiveWindow.ScrollRow = 452
    ActiveWindow.ScrollRow = 443
    ActiveWindow.ScrollRow = 422
    ActiveWindow.ScrollRow = 408
    ActiveWindow.ScrollRow = 346
    ActiveWindow.ScrollRow = 336
    ActiveWindow.ScrollRow = 305
    ActiveWindow.ScrollRow = 263
    ActiveWindow.ScrollRow = 216
    ActiveWindow.ScrollRow = 203
    ActiveWindow.ScrollRow = 182
    ActiveWindow.ScrollRow = 176
    ActiveWindow.ScrollRow = 168
    ActiveWindow.ScrollRow = 164
    ActiveWindow.ScrollRow = 156
    ActiveWindow.ScrollRow = 136
    ActiveWindow.ScrollRow = 134
    ActiveWindow.ScrollRow = 130
    ActiveWindow.ScrollRow = 127
    ActiveWindow.ScrollRow = 125
    ActiveWindow.ScrollRow = 121
    ActiveWindow.ScrollRow = 117
    ActiveWindow.ScrollRow = 110
    ActiveWindow.ScrollRow = 105
    ActiveWindow.ScrollRow = 94
    ActiveWindow.ScrollRow = 81
    ActiveWindow.ScrollRow = 75
    ActiveWindow.ScrollRow = 73
    ActiveWindow.ScrollRow = 71
    ActiveWindow.ScrollRow = 68
    ActiveWindow.ScrollRow = 67
    ActiveWindow.ScrollRow = 64
    ActiveWindow.ScrollRow = 61
    ActiveWindow.ScrollRow = 58
    ActiveWindow.ScrollRow = 54
    ActiveWindow.ScrollRow = 50
    ActiveWindow.ScrollRow = 45
    ActiveWindow.ScrollRow = 39
    ActiveWindow.ScrollRow = 38
    ActiveWindow.ScrollRow = 37
    ActiveWindow.ScrollRow = 36
    ActiveWindow.ScrollRow = 35
    ActiveWindow.ScrollRow = 34
    ActiveWindow.ScrollRow = 32
    ActiveWindow.ScrollRow = 30
    ActiveWindow.ScrollRow = 27
    ActiveWindow.ScrollRow = 26
    ActiveWindow.ScrollRow = 22
    ActiveWindow.ScrollRow = 20
    ActiveWindow.ScrollRow = 18
    ActiveWindow.ScrollRow = 16
    ActiveWindow.ScrollRow = 15
    ActiveWindow.ScrollRow = 14
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 12
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 9
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 4
    ActiveWindow.ScrollRow = 1
    ActiveWindow.ScrollColumn = 34
    ActiveWindow.ScrollColumn = 33
    ActiveWindow.ScrollColumn = 32
    ActiveWindow.ScrollColumn = 31
    ActiveWindow.ScrollColumn = 30
    ActiveWindow.ScrollColumn = 29
    ActiveWindow.ScrollColumn = 28
    ActiveWindow.ScrollColumn = 27
    ActiveWindow.ScrollColumn = 26
    ActiveWindow.ScrollColumn = 25
    ActiveWindow.ScrollColumn = 24
    ActiveWindow.ScrollColumn = 23
    ActiveWindow.ScrollColumn = 22
    ActiveWindow.ScrollColumn = 21
    ActiveWindow.ScrollColumn = 20
    ActiveWindow.ScrollColumn = 19
    ActiveWindow.ScrollColumn = 18
    ActiveWindow.ScrollColumn = 17
    ActiveWindow.ScrollColumn = 16
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 15
    Range("Z1").Select

'.........
    Range("AU3:BC3").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("BE3").Select

Here is my code to paste the values (can't figure out how to automate).

 Sub Copytofactsheet()
Range("AW73:BZ88").Select
Selection.ClearContents
Range("AW87:BE88").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-51]C[13]"
Range("AW85:BE86").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-50]C[13]"
Range("AW83:BE84").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-49]C[13]"
Range("AW81:BE82").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-48]C[13]"
Range("AW79:BE80").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-47]C[13]"
Range("AW77:BE78").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-46]C[13]"
Range("AW75:BE76").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-45]C[13]"
Range("AW73:BE74").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-44]C[13]"
Range("BF87:BP88").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-51]C[6]"
Range("BF85:BP86").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-50]C[6]"
Range("BF83:BP84").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-49]C[6]"
Range("BF81:BP82").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-48]C[6]"
Range("BF79:BP80").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-46]C[6]"
Range("BF79:BP80").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-47]C[6]"
Range("BF79:BP80").Select
Selection.ClearContents
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-47]C[6]"
Range("BF77:BP78").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-46]C[6]"
Range("BF75:BP76").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-45]C[6]"
Range("BF73:BP74").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-44]C[6]"
Range("BQ87:BZ88").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-51]C[-4]"
Range("BQ85:BZ86").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-50]C[-4]"
Range("BQ83:BZ84").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-49]C[-4]"
Range("BQ81:BZ82").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-48]C[-4]"
Range("BQ79:BZ80").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-47]C[-4]"
Range("BQ77:BZ78").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-46]C[-4]"
Range("BQ75:BZ76").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-45]C[-4]"
Range("BQ73:BZ74").Select
ActiveCell.FormulaR1C1 = "=Monthly_Returns!R[-44]C[-4]"
Range("AW73:BZ88").Select
Range("BQ87").Activate
Selection.NumberFormat = "0.0"
Selection.NumberFormat = "0"
Selection.NumberFormat = "0.0"
Selection.NumberFormat = "0.00"
Selection.NumberFormat = "0.000"
Selection.NumberFormat = "0.00"
Range("CD56").Select

Supporting Pictures

Thank you so much,

I can email the file directly to someone if that would be easier :)

(Edit: Fixed final code format due to a SO effect about code following a list)

You should really avoid using the `.Select` method. There is no need to activate a cell, range, sheet, or workbook to be able to modify its value, copy, or delete something. — urdearboy, Jul 05 '18 at 16:41

urdearboy · Answer 1 · 2018-07-05T16:50:23.703

This is not really a solution (will delete later) but more of an example of how your code can be adapted (and greatly shortened) to avoid the .Select method.

Although this is not a solution, you may be able to adapt methods used below to make your code cleaner and easier to follow. Readiability is important when it comes to debugging. Reading through useless lines (such as lines with .Select) does not help you find root issues!

You need to update Set WS = ThisWorkbook.Sheets("Sheet1") with your sheet name that houses the data that is being copied. Qualifying ranges is always good pratice so you konw there is no question of where your range is (active sheet, sheet(n), another book?).

Option Explicit

Sub Monthly_Returns_new_ws2()

Dim WS As Worksheet: Set WS = ThisWorkbook.Sheets("Sheet1")
Dim MR As Worksheet: Set MR = ThisWorkbook.Sheets("Monthly_Returns")

Dim CopyRange As Range
Set CopyRange = WS.Range("A4:Y" & WS.Range("Y" & WS.Rows.Count).End(xlUp).Row)
    CopyRange.Copy
    MR.Range("A4").PasteSpecial xlPasteValues

Dim i As Long

Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Application.ScreenUpdating = False

    For i = WS.Range("Y" & Rows.Count).End(xlUp).Row To 4 Step -1
        If WS.Range("Y" & i).Value = 0 Then Rows(i).EntireRow.Delete
    Next i

Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True

MR.Range("AA5:BC5").AutoFill Destination:=MR.Range("AA5:BC500"), Type:=xlFillDefault

End Sub

Automatting a Monthly Returns Report Using VBA in Excel

1 Answers1