VBA Optimize Processing of over 200,000 Entries

Question

I have over 200,000 rows and 9 columns I'm looking at that this code is running through. I'm basically having the code loop through the first 7 rows inputting the formulas from a IfElse statement. I'm also referencing another column on if the entry & (entry-1) are the same. That doesn't take long, but the problem is trying to duplicate/paste that down for the rest of the 199,993 entries. Then, I have another loop that'll just copy and paste the previous row of formulas to the next row and so forth. This is what takes forever. So, if there's something that'll make this process quicker I'd appreciate it. Currently it takes approximately 25 minutes to run.

Sub AddFormulas()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim endofcol As Long
Dim endofrow As Long
Dim i As Long
Dim j As Long

endofrow = 2
endofcol = 2

Do Until IsEmpty(Cells(endofcol, 7))
  endofcol = endofcol + 1
Loop

'Find IP30Bopd Column
With ActiveSheet.Range("A1:ZZ1")
  .Find("IP30Bopd").Select
  c = ActiveCell.Column
  r = ActiveCell.Row
End With

For j = 2 To 7
'ActiveSheet.Cells(j, c).Select   ***Don't think it's needed
  For i = c To (c + 8)
    ActiveSheet.Cells(j, i).Select
    If i = c Then
      'IP30Bopd Formula
      ActiveCell.FormulaR1C1 = "=RC[-2]/30.4"
    ElseIf i = c + 1 Then
      'IP30Boed Formula
      ActiveCell.FormulaR1C1 = "=sum(RC[-3]:RC[-2])/6"
    ElseIf i = c + 2 Then
      'IP30BoedX Formula
      ActiveCell.FormulaR1C1 = "=sum(RC[-4]:RC[-3])/14"
    ElseIf i = c + 3 Then
      'IP90Bopd Formula
      ActiveCell.FormulaR1C1 = "=if(R[-2]C[-10]=RC[-10],average(R[-2]C[-3]:RC[-3]),""*"")"
    ElseIf i = c + 4 Then
      'IP90Boed Formula
      ActiveCell.FormulaR1C1 = "=if(R[-2]C[-11]=RC[-11],average(R[-2]C[-3]:RC[-3]),"" * "")"
    ElseIf i = c + 5 Then
      'IP90BoedX Formula
      ActiveCell.FormulaR1C1 ="=if(R[-2]C[-12]=RC[-12],average(R[-2]C[-3]:RC[-3]),"" * "")"
    ElseIf i = c + 6 Then
      'IP180Bopd Formula
      ActiveCell.FormulaR1C1 ="=if(R[-5]C[-13]=RC[-13],average(R[-5]C[-6]:RC[-6]),"" * "")"
    ElseIf i = c + 7 Then
      'IP180Boed Formula
      ActiveCell.FormulaR1C1 = "=if(R[-5]C[-14]=RC[-14],average(R[-5]C[-6]:RC[-6]),"" * "")"
    Else: i = c + 8
      'IP180BoedX Formula
      ActiveCell.FormulaR1C1 = "=if(R[-5]C[-15]=RC[-15],average(R[-5]C[-6]:RC[-6]),"" * "")"
    End If
  Next i
Next j

For j = 7 To (endofcol - 1)
  ActiveSheet.Range(Cells(j, c), Cells(j, c + 8)).Copy    Destination:=ActiveSheet.Cells(j + 1, c)
Next j

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub

I highly suggest avoiding use of [`.Select`/`.Activate`](http://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros) to help speed it up. — BruceWayne, Nov 07 '16 at 17:49

score 1 · Answer 1 · answered Nov 07 '16 at 18:05

1

I suggest to process all entries in an array and only when you have done all calculations assign the array to cells Range

Instead of use ActiveSheet.Cells(j, i).Select use a Dim myArray(2 To 7, c To c + 8)

Don't do the calculation with formulas, use the vba code to compute data, is much faster.

When you done calculation, assign the array to sheet range Range("A1:H7") = myArray
"A1:H7" are only a sample, use the range that you need.

answered Nov 07 '16 at 18:05

Stefano Balzarotti

1,760
1
18
35

If there is a million+ cells it is hard to know what is faster without benchmarking. At least sometimes exploiting Excel's calculation engine for the heavy lifting is faster than a pure vba solution. – John Coleman Nov 08 '16 at 00:24
Some years ago, I've wrote a software to calculate all permutations of n elements in vba. I can assure you that calculating all records in memory and then assign to the sheet is hundreds of times faster than calculating directly on sheet cells. The only bad thing is that with millions of records it can consume some Gb of memory and 64 bit excel can be required. – Stefano Balzarotti Nov 08 '16 at 07:19
The only way that I've obtained acceptable performance in Conway's Game of Life in VBA is to have cells shrunk down to a few pixels with the onscreen universe containing 0 and 1 (with conditional formatting coloring them as appropriate) with an off-screen universe using thousands of spread-sheet formulas to update the universe. The heart of the VBA is the single line `Universe.Value = Next_Universe.Value`. It is able to go through over a dozen generations per second. I doubt that a pure-VBA solution would be better (see https://en.wikipedia.org/wiki/Conway%27s_Game_of_Life) – John Coleman Nov 08 '16 at 12:23
Personally I think that all depends in how is implemented the algorithm. I cannot tell you how the excel engine translate and optimize formulas in code, but I think that everything the engine does can be reproduced in VBA code with same performance. The main difference, is that with formulas you are restricted to use a fixed algorithm generated by engine, in VBA you are free to create your own implementation. – Stefano Balzarotti Nov 08 '16 at 14:41
The engine is multithreaded and runs compiled C/C++. VBA is a single-threaded interpreted language. In some contexts, using the calculation engine rather than VBA makes sense. There is no question that VBA is more flexible, but using the calculation engine rather than pure VBA is at least sometimes a good way to optimize the performance of numerically-intensive calculations. – John Coleman Nov 08 '16 at 15:46
The engine is compiled but the formulas are interpreted, so there aren't improvement in performance. The VBA code is interpreted like formulas and optimized at runtime by the native interpreter. The multithread instead can really improve performance, in this case the excel engine can provide better performance than VBA because pure VBA doesn't support threading. – Stefano Balzarotti Nov 08 '16 at 16:17
However with some tricks is possible to use multithreading even with VBA: http://analystcave.com/excel-multithreading-vba-vs-vbscript-vs-c-net/ – Stefano Balzarotti Nov 08 '16 at 16:19

score 1 · Accepted Answer · 2016-11-10T18:27:59.190

Instead of adding the formulas row by row add then all at once.

You still going to have a 1.2 million formulas in the worksheet. Calculating and updating the values using the VBA would be far more efficient.

Option Explicit

Sub AddFormulas()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim Start: Start = Timer
    Dim c As Range, Target As Range
    Dim lastRow As Long
    Dim FormulaR1C1

    FormulaR1C1 = getR1C1Array
    Set Target = Range("A1:ZZ1").Find("IP30Bopd")

    If Not Target Is Nothing Then
        lastRow = Cells(Rows.Count, 1).End(xlUp).Row
        Set Target = Target.Offset(1).Resize(UBound(FormulaR1C1, 1), UBound(FormulaR1C1, 2))
        Target.FormulaR1C1 = FormulaR1C1
        Set Target = Target.Rows(Target.Rows.Count).Resize(lastRow - Target.Rows.Count)
        Target.Rows(1).AutoFill Destination:=Target
        'Uncomment to replace worksheet formulas with their value for better performance
        Application.Calculation = xlCalculationAutomatic

        'Try ConvertR1C1toValues with both True and False to see which is faster
        ConvertR1C1toValues Target, False

    End If

    Debug.Print "Execution Time: "; Timer - Start
    Application.ScreenUpdating = True

End Sub

Sub ConvertR1C1toValues(Target As Range, ColumnbyColumn As Boolean)
    Dim c As Range
    Set Target = Intersect(Target.EntireColumn, Target.Parent.UsedRange)

    If ColumnbyColumn Then
        For Each c In Target
            c.Value = c.Value
        Next
    Else
       Target.Value = Target.Value
    End If
End Sub

Function getR1C1Array()
    Dim data
    ReDim data(6)
    data(0) = Array("=RC[-2]/30.4", "=SUM(RC[-3]:RC[-2])/6", "=SUM(RC[-4]:RC[-3])/14", "=IF(R[1048574]C[-6]=RC[-6],AVERAGE(RC[9]:R[1048574]C[9]),""*"")", "=IF(R[1048574]C[-7]=RC[-7],AVERAGE(RC[9]:R[1048574]C[9]),"" * "")", "=IF(R[1048574]C[-8]=RC[-8],AVERAGE(RC[9]:R[1048574]C[9]),"" * "")", "=IF(R[1048571]C[-9]=RC[-9],AVERAGE(RC[6]:R[1048571]C[6]),"" * "")", "=IF(R[1048571]C[-10]=RC[-10],AVERAGE(RC[6]:R[1048571]C[6]),"" * "")", "=IF(R[1048571]C[-11]=RC[-11],AVERAGE(RC[6]:R[1048571]C[6]),"" * "")")
    data(1) = Array("=RC[-2]/30.4", "=SUM(RC[-3]:RC[-2])/6", "=SUM(RC[-4]:RC[-3])/14", "=IF(R[-2]C[-6]=RC[-6],AVERAGE(R[-2]C[9]:RC[9]),""*"")", "=IF(R[-2]C[-7]=RC[-7],AVERAGE(R[-2]C[9]:RC[9]),"" * "")", "=IF(R[-2]C[-8]=RC[-8],AVERAGE(R[-2]C[9]:RC[9]),"" * "")", "=IF(R[1048571]C[-9]=RC[-9],AVERAGE(RC[6]:R[1048571]C[6]),"" * "")", "=IF(R[1048571]C[-10]=RC[-10],AVERAGE(RC[6]:R[1048571]C[6]),"" * "")", "=IF(R[1048571]C[-11]=RC[-11],AVERAGE(RC[6]:R[1048571]C[6]),"" * "")")
    data(2) = Array("=RC[-2]/30.4", "=SUM(RC[-3]:RC[-2])/6", "=SUM(RC[-4]:RC[-3])/14", "=IF(R[-2]C[-6]=RC[-6],AVERAGE(R[-2]C[-3]:RC[-3]),""*"")", "=IF(R[-2]C[-7]=RC[-7],AVERAGE(R[-2]C[-3]:RC[-3]),"" * "")", "=IF(R[-2]C[-8]=RC[-8],AVERAGE(R[-2]C[-3]:RC[-3]),"" * "")", "=IF(R[1048571]C[-9]=RC[-9],AVERAGE(RC[6]:R[1048571]C[6]),"" * "")", "=IF(R[1048571]C[-10]=RC[-10],AVERAGE(RC[6]:R[1048571]C[6]),"" * "")", "=IF(R[1048571]C[-11]=RC[-11],AVERAGE(RC[6]:R[1048571]C[6]),"" * "")")
    data(3) = Array("=RC[-2]/30.4", "=SUM(RC[-3]:RC[-2])/6", "=SUM(RC[-4]:RC[-3])/14", "=IF(R[-2]C[-6]=RC[-6],AVERAGE(R[-2]C[-3]:RC[-3]),""*"")", "=IF(R[-2]C[-7]=RC[-7],AVERAGE(R[-2]C[-3]:RC[-3]),"" * "")", "=IF(R[-2]C[-8]=RC[-8],AVERAGE(R[-2]C[-3]:RC[-3]),"" * "")", "=IF(R[1048571]C[-9]=RC[-9],AVERAGE(RC[6]:R[1048571]C[6]),"" * "")", "=IF(R[1048571]C[-10]=RC[-10],AVERAGE(RC[6]:R[1048571]C[6]),"" * "")", "=IF(R[1048571]C[-11]=RC[-11],AVERAGE(RC[6]:R[1048571]C[6]),"" * "")")
    data(4) = Array("=RC[-2]/30.4", "=SUM(RC[-3]:RC[-2])/6", "=SUM(RC[-4]:RC[-3])/14", "=IF(R[-2]C[-6]=RC[-6],AVERAGE(R[-2]C[-3]:RC[-3]),""*"")", "=IF(R[-2]C[-7]=RC[-7],AVERAGE(R[-2]C[-3]:RC[-3]),"" * "")", "=IF(R[-2]C[-8]=RC[-8],AVERAGE(R[-2]C[-3]:RC[-3]),"" * "")", "=IF(R[-5]C[-9]=RC[-9],AVERAGE(R[-5]C[6]:RC[6]),"" * "")", "=IF(R[-5]C[-10]=RC[-10],AVERAGE(R[-5]C[6]:RC[6]),"" * "")", "=IF(R[-5]C[-11]=RC[-11],AVERAGE(R[-5]C[6]:RC[6]),"" * "")")
    data(5) = Array("=RC[-2]/30.4", "=SUM(RC[-3]:RC[-2])/6", "=SUM(RC[-4]:RC[-3])/14", "=IF(R[-2]C[-6]=RC[-6],AVERAGE(R[-2]C[-3]:RC[-3]),""*"")", "=IF(R[-2]C[-7]=RC[-7],AVERAGE(R[-2]C[-3]:RC[-3]),"" * "")", "=IF(R[-2]C[-8]=RC[-8],AVERAGE(R[-2]C[-3]:RC[-3]),"" * "")", "=IF(R[-5]C[-9]=RC[-9],AVERAGE(R[-5]C[-6]:RC[-6]),"" * "")", "=IF(R[-5]C[-10]=RC[-10],AVERAGE(R[-5]C[-6]:RC[-6]),"" * "")", "=IF(R[-5]C[-11]=RC[-11],AVERAGE(R[-5]C[-6]:RC[-6]),"" * "")")
    data(6) = Array("=RC[-2]/30.4", "=SUM(RC[-3]:RC[-2])/6", "=SUM(RC[-4]:RC[-3])/14", "=IF(R[-2]C[-6]=RC[-6],AVERAGE(R[-2]C[-3]:RC[-3]),""*"")", "=IF(R[-2]C[-7]=RC[-7],AVERAGE(R[-2]C[-3]:RC[-3]),"" * "")", "=IF(R[-2]C[-8]=RC[-8],AVERAGE(R[-2]C[-3]:RC[-3]),"" * "")", "=IF(R[-5]C[-9]=RC[-9],AVERAGE(R[-5]C[-6]:RC[-6]),"" * "")", "=IF(R[-5]C[-10]=RC[-10],AVERAGE(R[-5]C[-6]:RC[-6]),"" * "")", "=IF(R[-5]C[-11]=RC[-11],AVERAGE(R[-5]C[-6]:RC[-6]),"" * "")")

    data = Application.Transpose(data)
    data = Application.Transpose(data)
    getR1C1Array = data

End Function

Function getFormulaR1C1Array(Source As Range)
    Dim r As Range
    Dim Result As String
    Result = "Array("
    For Each r In Source
        Result = Result & Chr(34) & Replace(r.FormulaR1C1, Chr(34), Chr(34) & Chr(34)) & Chr(34) & ","
    Next

    Result = Left(Result, Len(Result) - 1) & ")"

    getFormulaR1C1Array = Result

End Function

UPDATE:

I had to go 7 rows deep before I could get the formulas to fill right.

Extract the formula arrays from the worksheet - Select all the cells in 1 row that contain the formulas - Run this line in the Immediate Window

For x = 0 to 6:?"Data(";x;")=";getFormulaR1C1Array(Selection.Offset(x)):Next

Could you be elaborate on what the lastRow = formula is doing. I assume it's finding the last row from the Target Range, but I haven't used the .EntireColumn, (Rows.Count), or .End(xlUp).Row before. Look like they can be helpful later on! — PVic, Nov 07 '16 at 18:42
Also, when I try to run this I get a, "Run-time error '1004': Application-defined or object-defined error". Any way to resolve that? — PVic, Nov 07 '16 at 18:50
Where can I upload a sample file? I haven't done that before here. — PVic, Nov 07 '16 at 19:06
https://drive.google.com/file/d/0B4KXxRBWCA93MWdoSUt4Q3N6eEU/view?usp=sharing Let me know if this doesn't work please. — PVic, Nov 07 '16 at 19:23
Thank you Thomas, but now I'm getting a, "Compile error: Constant expression required". It highlights "Array" on line 4 in yellow. Any idea how to fix that? — PVic, Nov 08 '16 at 15:09
Actually, the R1C1 is a little off. The first row is correct, but every time the array is inputted it skips a row in the R1 Format. Row1 References Row1, Row2 References Row 3, Row3 References Row 5. Where it should be corresponding with each other. Any idea on how that can be fixed? — PVic, Nov 08 '16 at 16:49
I'm sorry Thomas, but there's one last little thing. The part you had commented out that'll replace the formulas with the values isn't working. It just pasts the values from row 8 to the rest of the rows. Any idea why it's doing that? — PVic, Nov 10 '16 at 14:45

VBA Optimize Processing of over 200,000 Entries

2 Answers2

UPDATE: