What makes my code run so slowly?

Question

As I said in the title, I'm wondering if someone can help me figure out why my code is running so slowly (Ran for an hour with no result). I'm very new when it comes to writing in VBA, but I don't see a reason why it would take so long. Here is the code in question:

Sub fast()
Application.ScreenUpdating = False

Dim prices As Worksheet
Dim stockreturns As Worksheet
Dim index As Worksheet
Dim stockprices As Range

Set index = Worksheets("IndexPrices")
Set prices = Worksheets("HistPrices")
Set stockreturns = Worksheets("Sheet1")

index.Range("A:B").Copy stockreturns.Range("A:B")

For col = 1 To 975
    For n = 2 To 260
        prices.Range("A:A").Offset(0, col).Copy stockreturns.Range("A:A").Offset(0, 2 * col + 1)
        If stockreturns.Cells(n + 1, 2 * col).Value = Null Or IsEmpty(stockreturns.Cells(n + 1, 2 * col).Value) Then
            stockreturns.Cells(n, 2 * col + 1) = Null
        Else
            stockreturns.Cells(n, 2 * col + 1).Formula = Cells(n, 2 * col) / Cells(n + 1, 2 * col) - 1
            stockreturns.Cells(n, 2 * col + 1).NumberFormat = "0.00%"
        End If
     Next n
Next col

Application.ScreenUpdating = True
End Sub

I'd be happy to post the workbook if anyone wants to see what I'm trying to accomplish in the sheet and potentially suggest a different or more efficient way of doing it. Thanks.

Answer 1

Before we move on the optimization, let's make sure at least it works. Please check where I comment. Assume that code above is correct. And in your code, you just modify to 260 rows so that I set last row to 260. I think this will need deeper debug to work. but if you follow this way, it will end up your program finish much faster (like hundreds of time faster than all normal methods above) The concept is similar. 1. Dump all data to memory ( array "stockdata and "pricedata") 2. Play with data in memory 3. write back to file 4. add format if required.

Sub fast()
Dim stockdata,pricedata As Variant

    Application.ScreenUpdating = False
    ' Stop Excel from recalculating the workbook every time a cell value changes
    Application.Calculation = xlCalculationManual
    Dim prices As Worksheet, stockreturns As Worksheet, index As Worksheet
    ' Fully qualify your sheets by specifying the workbook
    With ThisWorkbook
        Set index = .Sheets("IndexPrices")
        Set prices = .Sheets("HistPrices")
        Set stockreturns = .Sheets("Sheet1")
    End With
    ' Assign some last row number so you don't have to be copying the value of tens of thousands of rows
    ' Previously every values copy was on the entire column, wasting a lot of time!
    ' Could get this value by a cleverer, more dynamic method, but that depends on needs.
    Dim lastrow As Long: lastrow = 260

    ' Assign values, don't use copy/paste. Avoiding the clipboard speeds things up
    stockreturns.Range("A1:B" & lastrow).Value = index.Range("A1:B" & lastrow).Value
    pricedata = prices.Range("A1",prices.Cells(lastrow,975))
    redim stockdata(1 to lastrow, 1 to 1952)    
    For col = 1 To 975
        'stockreturns.Range("A1:A" & lastrow).Offset(0, 2 * col + 1).Value = prices.Range("A1:A" & lastrow).Offset(0, col).Value
        for n = 1 to lastrow
        'offset so that +1
            stockdata(n,col*2+1+1)  = pricedata(n,col+1)
        next n
    next col
    'done with that

    'check value and change if need
    For col = 1 To 975

        For n = 2 To 260
            If stockdata(n + 1, 2 * col) = Null Or IsEmpty(stockdata(n + 1, 2 * col)) Then
                stockdata(n, 2 * col + 1) = Null
            Else
                stockdata(n, 2 * col + 1).Formula = stockdata(n, 2 * col) / stockdata(n + 1, 2 * col) - 1
                'stockdata(n, 2 * col + 1).NumberFormat = "0.00%"
            End If
         Next n
    Next col
    stockreturns.Range("A1",stockreturns.Cells(lastrow,1952)) = stockdata
    Dim rng As Range
    Set rng = stockreturns.Range("B1:B" & lr)
    For col = 2 To 975
        Set rng = Union(rng, Range(stockreturns.Cells(1,2*col + 1),stockreturns.Cells(lr,2*col + 1),)
    next n
    rng.NumberFormat = "0.00%"
    ' Reset Application settings
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Answer 2

Assuming your code did what you want, the below redrafting should be much quicker.

1. Avoid using .Copy wherever possible. Instead directly assign the .Value of cells.
2. Make sure your lines of code are within the correct loops to avoid running code more often than it has to be run.
3. Stop doing every operation on entire columns, that's a lot of cells you're copying, of which 99% will be blank! I've taken the most basic approach possible and chosen to just use the first 1000 rows, improve this as suits - possibly by finding the actual last row.
4. Disable the automatic Calculation as well as the ScreenUpdating.

See code comments for details.

Sub fast()
    Application.ScreenUpdating = False
    ' Stop Excel from recalculating the workbook every time a cell value changes
    Application.Calculation = xlCalculationManual
    Dim prices As Worksheet, stockreturns As Worksheet, index As Worksheet
    ' Fully qualify your sheets by specifying the workbook
    With ThisWorkbook
        Set index = .Sheets("IndexPrices")
        Set prices = .Sheets("HistPrices")
        Set stockreturns = .Sheets("Sheet1")
    End With
    ' Assign some last row number so you don't have to be copying the value of tens of thousands of rows 
    ' Previously every values copy was on the entire column, wasting a lot of time!
    ' Could get this value by a cleverer, more dynamic method, but that depends on needs.   
    Dim lastrow As Long: lastrow = 1000
    ' Assign values, don't use copy/paste. Avoiding the clipboard speeds things up
    stockreturns.Range("A1:B" & lastrow).Value = index.Range("A1:B" & lastrow).Value
    For col = 1 To 975
        ' This line isn't affected by the value of n, so move it outside the n loop! Again, use .Value not copy
        stockreturns.Range("A1:A" & lastrow).Offset(0, 2 * col + 1).Value = prices.Range("A1:A" & lastrow).Offset(0, col).Value
        For n = 2 To 260            
            If stockreturns.Cells(n + 1, 2 * col).Value = Null Or IsEmpty(stockreturns.Cells(n + 1, 2 * col).Value) Then
                stockreturns.Cells(n, 2 * col + 1) = Null
            Else
                stockreturns.Cells(n, 2 * col + 1).Formula = Cells(n, 2 * col) / Cells(n + 1, 2 * col) - 1
                stockreturns.Cells(n, 2 * col + 1).NumberFormat = "0.00%"
            End If
         Next n
    Next col
    ' Reset Application settings
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub

Answer 3

Main issue:

This nested loop of yours executes 975 * 260 = 253.500 times:

For col = 1 To 975
    For n = 2 To 260
        prices.Range("A:A").Offset(0, col).Copy stockreturns.Range("A:A").Offset(0, 2 * col + 1)
        If stockreturns.Cells(n + 1, 2 * col).Value = Null Or IsEmpty(stockreturns.Cells(n + 1, 2 * col).Value) Then
            stockreturns.Cells(n, 2 * col + 1) = Null
        Else
            stockreturns.Cells(n, 2 * col + 1).Formula = Cells(n, 2 * col) / Cells(n + 1, 2 * col) - 1
            stockreturns.Cells(n, 2 * col + 1).NumberFormat = "0.00%"
        End If
     Next n
Next col

Summary of what you're doing, according to code in the question:

Basically, what you're doing is get column B, C, D, etc. and copy them to D, E, G, etc. using the offset. Next you check in the stockreturns worksheet what the value of the copied cell in the next row is (e.g. you check D3, then D4 etc.) and based on that populate E2, E3, etc. with nulls, or, alternatively you take ((D2 / D3) - 1) as a value there. The initial check is to avoid division by zero errors, I assume.

Note: In those lines in your code you refer to Cells(n, 2 * col) so that would always be the ActiveSheet, whereas I assume you want to populate the worksheet stockreturns with those values. I.e. if you run the formula with worksheet prices activated, the formula's won't give the desired output.

Working towards solution:

For sure it would be way faster to not do 253.500 loops, but to populate everything at once for as far as possible. Since the column number varies everytime, we'll leave that loop in, but the nested 260 loops we can easily get rid of:

Optimization to do 975 loops instead of 253.500:

With stockreturns
    For col = 1 To 975
        prices.Range("A:A").Offset(0, col).Copy .Range("A:A").Offset(0, 2 * col + 1)
        'Now we fill up the entire 260 rows at once using a relative formula:
        .Range(.Cells(2, 2 * col + 1), .Cells(260, 2 * col + 1)).FormulaR1C1 = "=IF(R[+1]C[-1]="""","""",(RC[-1]/R[+1]C[-1])-1)"
        'If you want a value instead of a formula, we replace the formula's with the value. If calculation is set to manual, you'll have to add an Application.Calculate here.
        .Range(.Cells(2, 2 * col + 1), .Cells(260, 2 * col + 1)).Value = .Range(.Cells(2, 2 * col + 1), .Cells(260, 2 * col + 1)).Value
        .Range(.Cells(2, 2 * col + 1), .Cells(260, 2 * col + 1)).NumberFormat = "0.00%"
    Next col
End With

This will already save major execution time. However, we can also save ourselves 975 calculate actions, by turning off calculations and only replacing the formulas with the values at the very end:

Second optimization to avoid calculations during execution:

Application.Calculation = xlCalculationManual
With stockreturns
    For col = 1 To 975
        prices.Range("A:A").Offset(0, col).Copy .Range("A:A").Offset(0, 2 * col + 1)
        'Now we fill up the entire 260 rows at once using a relative formula:
        .Range(.Cells(2, 2 * col + 1), .Cells(260, 2 * col + 1)).FormulaR1C1 = "=IF(R[+1]C[-1]="""","""",(RC[-1]/R[+1]C[-1])-1)"
        .Range(.Cells(2, 2 * col + 1), .Cells(260, 2 * col + 1)).NumberFormat = "0.00%"
    Next col
End With
Application.Calculate
stockreturns.UsedRange.value = stockreturns.UsedRange.value

This last version runs in seconds. If it is acceptable for you to alter the stockreturns worksheet layout and use a continuous range to copy to at once, you won't need those 975 loops either but you can achieve the desired result with the following actions:

• Copy prices range
• Add the formula in another range
• Calculate
• Replace formulas with values
• Set numberformat

Hope this helps.