Optimising Read/Write Speed of Excel VBA Copy/Paste Macro

Question

I have an Excel sheet that connects to third party software which populates Sheet1 with data. It does this multiple times per second and overwrites previous data.

I have written the macro below to copy and paste the data to a sheet (called Data) each time there is a change to Sheet1.

The previous version of the macro looped down a range copying one row at a time which took a (relatively) long time as there can be 50000+ rows in the Data seet.

The current version uses a variant array but still seems to be very resource-hungry.

Are there any other ways it can be optimised to make it more efficient?

Thanks

Private Sub Worksheet_Change(ByVal Target As Range)

    If Target.Columns.Count <> 16 Then Exit Sub
             
    'Count the cells to copy
    Dim a As Integer
    With ThisWorkbook.Worksheets("Sheet1")
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
        inarr = .Range(.Cells(1, 1), .Cells(lastRow + 5, 26)) ' load all of sheet 1 data in a variant array
    End With
    a = lastRow
    'Count the last cell where to start copying
    Dim b As Long
    
    With ThisWorkbook.Worksheets("Data")
        b = .Cells(Rows.Count, "A").End(xlUp).Row
            
        Dim c As Integer
        c = 5
        'Perform the copy paste process
        Dim outarr() As Variant
        ReDim outarr(1 To a, 1 To 22)
        Application.EnableEvents = False
        For i = 1 To a - 1
        
            If ThisWorkbook.Worksheets("Sheet1").Range("E2") <> "" And ThisWorkbook.Worksheets("Sheet1").Range("F2") = "" And ThisWorkbook.Worksheets("Sheet1").Range("AB5") = "35" Then
                outarr(i, 1) = inarr(3, 14)
                outarr(i, 2) = inarr(2, 2)
                outarr(i, 3) = inarr(1, 1)
                outarr(i, 4) = inarr(2, 5)
                outarr(i, 5) = inarr(c, 26)
                outarr(i, 6) = inarr(c, 1)
                outarr(i, 7) = inarr(c, 6)
                outarr(i, 8) = inarr(c, 8)
                outarr(i, 9) = inarr(c, 15)
                outarr(i, 10) = inarr(c, 16)
                outarr(i, 11) = inarr(3, 2)
                outarr(i, 12) = inarr(c, 7)
                outarr(i, 13) = inarr(c, 2)
                outarr(i, 14) = inarr(c, 3)
                outarr(i, 15) = inarr(c, 4)
                outarr(i, 16) = inarr(c, 5)
                outarr(i, 17) = inarr(c, 9)
                outarr(i, 18) = inarr(c, 12)
                outarr(i, 19) = inarr(c, 13)
                outarr(i, 20) = inarr(c, 10)
                outarr(i, 21) = inarr(c, 11)
                outarr(i, 22) = inarr(c, 25)
                
                c = c + 1
            End If
        Next i
        ThisWorkbook.Worksheets("Data").Range(.Cells(b + 1, 1), .Cells(b + a - 4, 22)) = outarr
    End With
    Application.EnableEvents = True

    'End If


    Dim lastcell As Range
    Dim wsStore As Worksheet
    
    Set wsStore = ThisWorkbook.Worksheets("Store")
    
    Set lastcell = wsStore.Cells(wsStore.Rows.Count, 1).End(xlUp)
    
    With ThisWorkbook.Worksheets("Sheet1").Range("F2")
're-set F2 when last cell of the Store sheet is no longer the same as the value in N3
        If .Value = "Closed" And Val(.ID) <> xlOff Then
            .ID = xlOff
                
            Call CopyToStore
            Call ClearData
        
        ElseIf .Offset(1, 8).Value <> lastcell.Value Then
            .ID = xlOn
        End If
    End With

End Sub

Answer 1

Option Explicit

(Best Practice) Always declare Option Explicit at the top of your modules. This allows the compiler to flag the use of variables that have not been explicitly declared. This helps to reveal hard to find bugs - especially those due to typos. Make it automatic: in the VBIDE, check the 'Tools -> Options... -> (Editor tab) 'Require Variable Declaration' option. FWIW: Declaring it for the posted code found 3 undeclared variables.

Optimization

When optimizing a loop, the first step is to remove everything that does not absolutely have to execute within the loop.

As written, the statement...

If ThisWorkbook.Worksheets("Sheet1").Range("E2") <> "" And ThisWorkbook.Worksheets("Sheet1").Range("F2") = "" And ThisWorkbook.Worksheets("Sheet1").Range("AB5") = "35" Then

is located such that it is executed for every value of i...but the outcome of the expression does not depend on i. So, this statement, which currently de-references ThisWorkbook.Worksheets("Data") 3 (x 50000+) times, can be moved outside of the loop and executed only once. Organizing the code as follows, removes the inefficiency:

        Dim copyArrayElements As Boolean
        With ThisWorkbook.Worksheets("Sheet1")
            copyArrayElements = .Range("E2") <> "" And .Range("F2") = "" And .Range("AB5") = "35"
        End With

        If copyArrayElements Then

            For i = 1 To a - 1
                outarr(i, 1) = inarr(3, 14)

                '...the rest of the assignments

                outarr(i, 22) = inarr(c, 25)

                c = c + 1
            Next i
        End If

Application flags

Within the subroutine, Application.EnableEvents is set to False and then reset to True. It is important that this flag is reliably reset. However, it is possible for an error to occur before it is reset. The simplest change to ensure this flag is always reset is to add error handling to the subroutine. Like:

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Columns.Count <> 16 Then Exit Sub
    
On Error GoTo ErrorExit
    '... the rest of the subroutine...
    
ErrorExit:
    Application.EnableEvents = True
    'Any other code that HAS to execute in the event of an error
End Sub

Even though 'Application.EnableEvents' is set to True before the end of the function (when there are no error(s)), there is no harm in setting it again in the error handler.

Big 'With' blocks

With statements can make code easier to read, and in some cases execute a little faster. However, if there are a lot of lines of code between the With and End With, it is easy to lose track of what object is used within the With statement. That appears to have happened here:

    Dim b As Long

    With ThisWorkbook.Worksheets("Data")
        b = .Cells(Rows.Count, "A").End(xlUp).Row

    '... the rest of code within the With block
    
        ThisWorkbook.Worksheets("Data").Range(.Cells(b + 1, 1), .Cells(b + a - 4, 22)) = outarr
    End With

The last statement in the With block should be .Range(.Cells(b + 1, 1), .Cells(b + a - 4, 22)) = outarr. There are so many lines of content between the start and end of the With block, that the purpose of the With block is easily lost. And, as far as I can tell, there is only one other use of the '.' operator(b = .Cells(Rows.Count, "A").End(xlUp).Row). In this case, the code will not run perceptibly slower if this With block is removed. But, there is definitely a reduction in the cognitive effort to understand the code.

Validations

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Columns.Count <> 16 Then Exit Sub

The above statement validates the Target parameter. Anything other than a target Range of exactly 16 columns does not warrant executing the subsequent code. And, it looks like there may be other criteria as well. The code example above that declared and set the variable copyArrayElements looks like a candidate to execute at the top of the subroutine. If copyArrayElements is False, does it make sense to execute any of the remaining code?

So, perhaps...

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Target.Columns.Count <> 16 Then Exit Sub

    Dim copyArrayElements As Boolean
    With ThisWorkbook.Worksheets("Sheet1")
        copyArrayElements = .Range("E2") <> "" And .Range("F2") = "" And .Range("AB5") = "35"
    End With

    If Not copyArrayElements Then Exit Sub

would be an appropriate context validation criteria as well