4
\$\begingroup\$

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
\$\endgroup\$
  • 3
    \$\begingroup\$ This is the same code as in codereview.stackexchange.com/questions/196584/… \$\endgroup\$ – AJD Jun 18 '18 at 20:06
  • \$\begingroup\$ Possible duplicate of Performing transformations on files \$\endgroup\$ – AJD Jun 18 '18 at 20:06
  • \$\begingroup\$ And my previous question remains - in the context you have previously given, not all of the routine or arguments are required. Why is this so complicated? Can you explain the code? \$\endgroup\$ – AJD Jun 18 '18 at 20:07
6
\$\begingroup\$

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
\$\endgroup\$
4
\$\begingroup\$

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.

\$\endgroup\$
  • \$\begingroup\$ Thank you. Anyway you could show me ? \$\endgroup\$ – excelguy Jun 18 '18 at 15:35
  • \$\begingroup\$ Can you dynamically get the number of rows and columns from the array with UBound and LBound or do you need the ability to explicitly define how much of the array is written? If you need those parameters then you would have to resize the array before it is dumped on to the sheet. \$\endgroup\$ – HackSlash Jun 18 '18 at 15:55
  • \$\begingroup\$ Nrows = 7440 , ncols = 18 , Ubound = 7440 , They are dynimcally gotten with these, I dont need the ability to explicitly define the cols and rows to write too. \$\endgroup\$ – excelguy Jun 18 '18 at 16:17
2
\$\begingroup\$
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.

\$\endgroup\$
  • \$\begingroup\$ It is also possible to record the value of Application.ScreenUpdating in a temp variable at the beginning of the routine, and restore the value at the end of the routine. \$\endgroup\$ – Jasper Jun 19 '18 at 6:23
1
\$\begingroup\$

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
\$\endgroup\$
1
\$\begingroup\$

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!

\$\endgroup\$
  • \$\begingroup\$ So for practical purposes what would I sent the tArr range to, and the Me Range to? Like which sheets/cells ? \$\endgroup\$ – excelguy Jun 21 '18 at 21:42
  • \$\begingroup\$ When I tested this, I had put the test routines in the Worksheet modules, which is why I used Me. But, test1 and test2a are only examples, you pass in whichever 2-D array you think is necessary and you set the starting cell to whatever you want. \$\endgroup\$ – AJD Jun 22 '18 at 6:17

Not the answer you're looking for? Browse other questions tagged or ask your own question.