What makes my code run so slowly? - vba

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

Assuming your code did what you want, the below redrafting should be much quicker.
Avoid using .Copy wherever possible. Instead directly assign the .Value of cells.
Make sure your lines of code are within the correct loops to avoid running code more often than it has to be run.
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.
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 2

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.

Answer 3

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