Writing an array to a worksheet When I run my code, I get an "Excel not responding" error at this sub as I step through the code, more specifically the write portion of this code. Can anyone help optimize this? I think this is because the loop is writing so many records cell by cell (50k) records and it's causing my Excel sheet to become unresponsive.

 'writes the nRows and nCols from arr to startCell
    'if fromTop is true it starts reading from the first element of arr, otherwise it starts fromm the last element
    Public Sub writeArrToWS(arr() As Variant, startCell As Range, fromTop As Boolean, nRows As Long, nCols As Long)

        Dim i As Long, j As Long, startRow As Long, startCol As Long
        Dim thisWS As Worksheet
        Dim writeVal As Variant

        Set thisWS = startCell.Worksheet

        startRow = startCell.row
        startCol = startCell.Column

        'clear
        For i = 1 To nRows
            For j = 1 To nCols
                thisWS.Cells(startRow + i - 1, startCol + j - 1).value = ""
            Next j
        Next i

        'write
        For i = 1 To WorksheetFunction.Min(nRows, UBound(arr, 1))
            For j = 1 To nCols
                If fromTop Then writeVal = arr(i, j) Else writeVal = arr(UBound(arr, 1) - i + 1, j)
                thisWS.Cells(startRow + i - 1, startCol + j - 1).value = writeVal
            Next j
        Next i

    End Sub
This minimizes the interaction with the range (as mentioned by @M.Doerner)
and clears the previous data in one operation (mentioned by @Patrick)


Determines the range to work with


Minimum between arr().Rows and nRows, and arr().Cols and nCols
Establishes the UsedRange based on startCell, and Cells(nRows, nCols)

Clears entire UsedRange
If fromTop is True places arr() into the UsedRange
Else, reverses rows in arr() into variant array result, then places it into UsedRange




Rows: 100,001; Cols: 20; fromTop: True  - Time: 4.461 sec
Rows: 100,001; Cols: 20; fromTop: False - Time: 4.734 sec




Option Explicit

'writes the 2-D arr to startCell; if fromTop is False it starts from the last row
Public Sub WriteArrToWS(ByRef arr() As Variant, ByRef startCell As Range, _
                        ByVal fromTop As Boolean, nRows As Long, nCols As Long)

    nRows = IIf(nRows &lt; UBound(arr, 1), nRows, UBound(arr, 1))
    nCols = IIf(nCols &lt; UBound(arr, 2), nCols, UBound(arr, 2))

    Dim ws As Worksheet, fr As Long, fc As Long, ur As Range

    Set ws = startCell.Worksheet
    fr = startCell.Row
    fc = startCell.Column
    Set ur = ws.Range(ws.Cells(fr, fc), ws.Cells(fr + nRows - 1, fc + nCols - 1))
    ur.ClearContents

    Dim result As Variant, r As Long, c As Long, lr As Long

    result = ur
    result = arr            'Defaults to fromTop = True
    If Not fromTop Then     'If fromTop = False, reverses the rows in the array
        lr = nRows
        For r = 1 To nRows
            For c = 1 To nCols
                result(r, c) = arr(lr, c)
            Next
            lr = lr - 1
        Next
    End If
    ur = result
End Sub