Writing an array to a worksheet [closed]

Question

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

Answer 1

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 < UBound(arr, 1), nRows, UBound(arr, 1))
    nCols = IIf(nCols < 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

Answer 2

A faster alternative to writing the values individually is to assign the Variant array to the Value property of the top left cell of the range you want to past it into. That writes the array in one go.

This will require using a second array to invert the ordering in case fromTop is False.

Answer 3

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

' Place actual code between the above and below

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True    

Without the above, I've found Excel becomes unresponsive with a lot of writes to the sheet. I believe it's due to Excel trying to recalculate and display those changes with each write.

Answer 4

One thing you can do is not loop through all your cells to clear them out. Use this instead:

With thisWS
    .Range(.Cells(startRow, startCol), _
           .Cells(startRow + nRows - 1, startCol + nCols - 1)).ClearContents
End With

Answer 5

As noted in your previous question (where the full context for this routine was exposed), you have added complications where none was necessary.

Public Sub writeArrToWS(arr() As Variant, startCell As Range, fromTop As Boolean, nRows As Long, nCols As Long)

Knowing this context, I know that:

• Arr() is a two dimensional array
• nRows = UBound(arr,1)
• nCols = UBound(Arr,2)
• You only call it once and FromTop is True

As such, your spaghetti can be reduced to the following to meet your contextual need.

Public Sub writeArrToWS(arr() As Variant, startCell As Range)
    Dim targetRange As Range
    Set targetRange = startCell ' assumes startCell is a single cell. Could do error checking here!
    Set targetRange = targetRange.Resize(UBound(arr, 1), UBound(arr, 2))
    targetRange.ClearContents ' don't even think this is necessary.
    targetRange = arr
End Sub

(Tested and worked for me)

For future re-use, simply reverse the array before you enter the sub-routine - this would be the quickest and most efficient means.

Here are two test routines, the first forwards, the second backwards (*) - Range L3:O15 was filled with test data:

Sub test1()
    Dim tArr() As Variant
    tArr = Range("L3:O15").Value
    writeArrToWS tArr, Me.Range("A3")
End Sub

Sub test2a()
    Dim tArr() As Variant
    Dim tArr2() As Variant
    Dim ti As Long ' iterator
    Dim tj As Long ' iterator
    Dim tLengthArr As Long ' handy variable - easier to read than UBound etc. But is equivalent to UBound(tarr,1)
    Dim tWidthArr As Long ' handy variable - easier to read than UBound etc. But is equivalent to UBound(tarr,2)
    tArr = Range("L3:O15").Value
    tLengthArr = UBound(tArr, 1)
    tWidthArr = UBound(tArr, 2)
    ReDim tArr2(tLengthArr, tWidthArr)
    For ti = 1 To tLengthArr
        For tj = 1 To tWidthArr
            tArr2(ti, tj) = tArr(tLengthArr - ti + 1, tj)
        Next tj
    Next ti
    writeArrToWS tArr2, Me.Range("A3")
End Sub

(*) I struck an interesting problem on the backwards version. I used debug to prove the array was filling correctly and had the right dimensions. I even checked to see if the targetRange was the correct range. But when the data was written, the first column was blank and the next three columns were the first three columns. Yes, Option explicit is on. Don't understand!