How can I eliminate printing rows to an Excel sheet, and instead add the desired records (Rows) to an array (VBA)?

Question

I have code that does the following:

• Creates a dictionary for items in Production (Production_Dictionary) and Development (Development_Dictionary)
• Loops over a production dataset that has been assigned to an array (Production_Array)
• Using a key (Production Item), it checks if the development dataset contains the production record
• If not, it prints the record (row) on a sheet for deleted items (Delete_Sheet)
• If so, it checks if any of the columns (fields) have changed
• If a field has changed, it will print the record (row) on a sheet for changed items (Change_Sheet) and highlight the changed fields

Here is the code, which functions as expected, but is slow:

For i = 1 To UBound(Production_Array, 1) '1 indicates upper-bound of rows
    Production_Item = Production_Array(i, ProductionID_1) & Production_Array(i, ProductionID_2) & Production_Array(i, ProductionID_3)
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Find Deleted Records
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    If Not Development_Dictionary.exists(Production_Item) Then 'If Production Item not found in Development
        Delete_Row = Delete_Sheet.Range("A1").CurrentRegion.Rows.Count + 1
        Set Delete_Record = Delete_Sheet.Range(Delete_Sheet.Cells(Delete_Row, 1), Delete_Sheet.Cells(Delete_Row, Last_Column_Development))
        Delete_Record = Application.Index(Production_Array, i)
        GoTo LineNext
    End If
    
    ItemRow = Development_Dictionary(Production_Item)
    
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    'Find Changed Records
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    For x = 1 To Last_Column_Production 'Checking all fields for changes - Only for records found in each data set
        If Production_Array(i, x) <> Development_Array(ItemRow, x) Then

            If Not Pasted_Record Then
                Change_Row = Change_Sheet.Range("A1").CurrentRegion.Rows.Count + 1
                Set Change_Record = Change_Sheet.Range(Change_Sheet.Cells(Change_Row, 1), Change_Sheet.Cells(Change_Row, Last_Column_Production))
                Change_Record = Application.Index(Production_Array, i) 'Production_Record.Value
                Pasted_Record = True
            End If

            Change_Sheet.Cells(Change_Row, x).Interior.Color = vbRed
        End If
    Next x

Pasted_Record = False
LineNext:
Next i

I have tried everything I can find on stack overflow to avoid constantly referencing an Excel sheet for each changed/deleted record. My hope was to assign all changed/deleted records to a separate array, and then paste the array on the Excel sheet after I have finished with each dataset.

Application.Index methodologies have been great for returning a row, but not for adding that row to another array with unknown size. I could not get around this issue with Redim Preserve statements, though there was some type of transposing methodology (for application.index) that looked promising, but was too confusing to understand.

Answer 1

I can't compile or test this, but it should give you some idea on how to handle compiling the "change" and "delete" data.

Sub tester()
    Dim ubR As Long, ubC As Long, changes, deletes
    
    '...
    ubR = UBound(ProductionArray, 1)
    ubC = UBound(ProductionArray, 2)
    
    'resize output arrays to max possible required size
    ReDim changes(1 To ubR, 1 To ubC)
    changeNum = 0
    ReDim deletes(1 To ubR, 1 To ubC)
    deleteNum = 0
    
    
    For i = 1 To ubR '1 indicates upper-bound of rows
        
        'should realy use a separator here
        Production_Item = Join(Array(Production_Array(i, ProductionID_1), _
                                     Production_Array(i, ProductionID_2), _
                                     Production_Array(i, ProductionID_3)), "~~")
        
        If Not Development_Dictionary.Exists(Production_Item) Then 'If Production Item not found in Development
            CopyRow Production_Array, i, deletes, deleteNum 'add to deletes array
        Else
            ItemRow = Development_Dictionary(Production_Item)
            'Find Changed Records
            For x = 1 To Last_Column_Production 'Checking all fields for changes - Only for records found in each data set
                If Production_Array(i, x) <> Development_Array(ItemRow, x) Then
                    CopyRow Production_Array, i, changes, changeNum
                    Exit For 'stop checking column values
                End If
            Next x
        End If
    Next i
    
    'put deletes on worksheet
    If deleteNum > 0 Then
        With Delete_Sheet.Cells(Delete_Sheet.Range("A1").CurrentRegion.rows.count + 1, "A")
            .Resize(deleteNum, UBound(deletes, 2)).Value = deletes
        End With
    End If
    
    'same for changes...
    
End Sub

'Given two 2D 1-based arrays, copy row `srcRow` from `arrSrc` over to `arrDest`
'  Handles incrementing `destRow` on each call; hence explicit `ByRef`
Sub CopyRow(arrSource, srcRow As Long, arrDest, ByRef destRow As Long)
    Dim col As Long
    destRow = destRow + 1 'increment destination row to copy to
    For col = 1 To UBound(arrSource, 2)
        arrDest(destRow, col) = arrSource(srcRow, col)
    Next col
End Sub