optimize my VBA code, so it runs faster / stock prices computations

Question

I need to optimize my code, so it runs faster. There is only 12 000 computations in it. I have around 6 000 rows in my worksheet, and I need to count rate of return in one column and logarithmic rate of return in the other.

The problem is that, when I do these counting using Excel formulas, it takes like 2-3 sec per column, so rate of return for 6 000 rows is counted in 2 sec and the same with logarithmic rate of return in second column. But my code takes 60 seconds to run. How is that even possible? I was sure VBA computing will be much faster than that.

Sub Normal_Return_Rate()

  Dim ws As Worksheet
  Dim current_price As Single
  Dim previous_price As Single
  Dim a_cell As Range
  Dim b_cell As Range
  Dim vba_cell As Range
  Dim row As Long
  Dim b_col As Integer
  Dim vba_col As Integer
  Dim last_row As Long

  Dim start As Double
  Dim finish As Double
  Dim total_time As Double

  Application.ScreenUpdating = False
  start = Timer                   ' remember time when macro starts.


  Set ws = Workbooks("lista_spolek_gpw.xlsm").Worksheets("MBank_Statsy")
  last_row = ws.Cells(Rows.Count, 1).End(xlUp).row

  row = 3
  Set a_cell = ws.Range("A1:ZZ1").Find(What:="LOW", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, _
                                MatchCase:=False, SearchFormat:=False)
  Set b_cell = ws.Range("A1:ZZ1").Find(What:="CLOSE", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, _
                                MatchCase:=False, SearchFormat:=False)
  Set vba_cell = ws.Range("A1:ZZ1").Find(What:="VBA code" & Chr(10) & "result", LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, _
                                MatchCase:=True, SearchFormat:=False)

  b_col = b_cell.Column
  vba_col = vba_cell.Column
  ws.Cells(row, b_col).Activate

  With ws.Range("M3:N" & last_row)                 
                  ' previous version:   ws.Range("M2:N" & Rows.Count)
       .HorizontalAlignment = xlGeneral
       .VerticalAlignment = xlCenter
       .WrapText = False
       .NumberFormat = "00.00%"
       .Orientation = 0
       .AddIndent = False
       .IndentLevel = 0
       .ShrinkToFit = False
       .ReadingOrder = xlContext
       .MergeCells = False
       .ColumnWidth = 13
  End With


   With ws
       Do While Cells(row, b_col) <> ""
          current_price = ActiveCell.Value
          previous_price = ActiveCell.Offset(-1, 0).Value
          ws.Cells(row, vba_col) = Round(current_price / previous_price - 1, 4)
          ws.Cells(row, 14) = Log(current_price / previous_price)
          row = row + 1
          ws.Cells(row, b_col).Activate
       Loop
   End With

 finish = Timer
 total_time = Round(finish - start, 3)       ' Calculate total time.
 MsgBox "This code ran successfully in " & total_time & " seconds", vbInformation
 Application.ScreenUpdating = True

End Sub

Any piece of advice which will make this code run faster is highly appreciated. I'm just the beginner in VBA.

This is how the sheet looks like - its stock quotes sheet. The computations are using values from "CLOSE" column.

Answer 1

I built a simplified version of your code and got an almost identical runtime.

Next I updated this simplified version to work with arrays. It is substantially faster.

My Code uses some hardcoded values, but my goal was not to find the solution for you but to get a solution which helps you write the code yourself. Hope it helps.

Sub Normal_Return_Rate_fast()
Dim ws As Worksheet
Dim last_row As Long
Dim row As Long
Dim b_col As Integer
Dim arr As Variant
Dim res() As Double



Application.ScreenUpdating = False
start = Timer

Set ws = Workbooks("Book1.xlsm").Worksheets("Sheet1")
last_row = ws.Cells(Rows.Count, 1).End(xlUp).row
row = 2
b_col = 1

arr = Range("A2:A6000").Value
size_x = last_row - row + 1
ReDim res(size_x, 2) As Double
Dim i As Long
For i = 2 To UBound(arr, 1)
    res(i - 2, 0) = Round(arr(i, 1) / arr(i - 1, 1) - 1, 4)
    res(i - 2, 1) = Log(arr(i, 1) / arr(i - 1, 1))
Next i

Range("B3:C6000").Value = res

finish = Timer
total_time = Round(finish - start, 3)       ' Calculate total time.
MsgBox "This code ran successfully in " & total_time & " seconds", vbInformation
Application.ScreenUpdating = True

End Sub

This is how my "TestWorkbook" looks like.

Just 1 to 5999 in column A.