vba code taking too long (Offset) Code running in excel to populate rows columns of worksheet

Question

I have following piece of code that writes from memory into rows\columns of a spreadsheet. If there are 200 records, it takes several minutes. I do not understand why it should be that slow BECAUSE there is no disk I/O. Everything should be happening in memory. So why it takes several minutes beats me.

Any ideas on how to make it faster? Is Offset the culprit? BTW, TagValues is a two dimensional array.

Private Sub PopulateGrid()


    Dim i As Integer
    Dim r As Range
    Dim RowOffset As Integer
    Dim CurRow As Integer
    Dim StartCol As String

    RowOffset = 15
    StartCol = "B"

    MsgBox "Grid population will start after you press OK.  This might take a few minutes.  Please wait while we populate the grid.  You will be alerted when completed."

    Set r = ActiveSheet.Range("B16")

    For i = 1 To TotalRecords
        CurRow = RowOffset + i
        Set r = ActiveSheet.Range(StartCol + CStr(CurRow))
        r.Value = TagValues(i, cTagNo)

        Set r = r.Offset(0, 1)
        r.Value = Qty(i)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cSize)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cValveType)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cBodyStyle)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cPressureClass)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cOperator)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cEndConfiguration)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cPort)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cBody)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cTrim)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cStemHingePin)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cWedgeDiscBall)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cSeatRing)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cORing)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cPackingSealing)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cGasket)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cWarrenValveFigureNo)
        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cWarrenValveTrimCode)
        Set r = r.Offset(0, 1)
        r.Value = RemoveLastLineBreakAndTrim(TagValues(i, cComments))

        Set r = r.Offset(0, 1)
        r.Value = TagValues(i, cDelivery)

        Set r = r.Offset(0, 1)
        r.Value = ""

        Set r = r.Offset(0, 1)
        r.Value = ""

        Set r = r.Offset(0, 1)
        r.Value = ""

        Set r = r.Offset(0, 1)
        r.Value = ""

        Set r = r.Offset(0, 1)
        r.Value = ""

        Set r = r.Offset(0, 1)
        r.Value = ""

        Set r = r.Offset(0, 1)
        r.Value = ""

        Set r = r.Offset(0, 1)
        r.Value = ""

        Set r = r.Offset(0, 1)
        r.Value = ""

        Set r = r.Offset(0, 1)
        r.Value = ""

        Set r = r.Offset(0, 1)
        r.Value = ""

        Set r = r.Offset(0, 1)
        r.Value = ""

        Set r = r.Offset(0, 1)
        r.Value = Price(i)

        Set r = r.Offset(0, 1)
        r.Value = ExtPrice(i)

    Next

    MsgBox "Grid Population completed."

End Sub

This is not happening in memory, every time you reference the worksheet you slow down the code. If you want to speed this up you will need to use variant arrays and assign the array to the range at one time. — Scott Craner
– Scott Craner, Commented Jun 25, 2018 at 20:51
For example you can skip the whole loop and assign each column as a whole: ActiveSheet.Range("B16").Resize(TotalRecords).Value = Application.Index(TagValues,0,cTagNo) — Scott Craner
– Scott Craner, Commented Jun 25, 2018 at 21:05

SeanW333 · Accepted Answer · 2018-06-25 21:03:56Z

It's hard to know without seeing the data with which you're working, but here are a couple things that should help:

Sub test()

    ' Disable visual and calc functions
    ' So Excel isn't updating the display and
    ' recalculating formulas every time you
    ' fill another cell
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual

    ' Instead of resetting r each time,
    ' Try more like this:
    Set r = ActiveSheet.Range(StartCol + CStr(CurRow))
    r.Value = TagValues(i, cTagNo)

    r.Offset(0, 1).Value = TagValues(i, cSize)
    r.Offset(0, 2).Value = TagValues(i, cValveType)
    r.Offset(0, 3).Value = TagValues(i, cBodyStyle)
    ' etc, etc, etc.
    ' Less steps for the processor
    ' Easier maintenance for you


    ' Enable visual and calc functions
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic   



End Sub

Tim Williams · Accepted Answer · 2018-06-26 00:01:43Z

1

It would fastest to create a 2-D array of the required size in-memory, fill it from your source data, then drop it directly onto the worksheet.

Untested:

Private Sub PopulateGrid()

    Const RowOffset As Long = 15
    Const StartCol As String = "B"
    Const NUMCOLS As Long = 5

    Dim i As Integer
    Dim arrOut()

    ReDim arrOut(1 To totalrecords, 1 To NUMCOLS)

    For i = 1 To totalrecords

        'shorter set of columns to illustrate the approach...
        arrOut(i, 1) = TagValues(i, cTagNo)
        arrOut(i, 2) = Qty(i)
        arrOut(i, 3) = TagValues(i, cSize)
        arrOut(i, 4) = TagValues(i, cValveType)
        arrOut(i, 5) = TagValues(i, cBodyStyle)

    Next

    ActiveSheet.Range("B16").Resize(totalrecords, NUMCOLS).Value = arrOut

End Sub

edited Jun 26, 2018 at 0:01

answered Jun 25, 2018 at 23:52

Tim Williams

169k8 gold badges104 silver badges143 bronze badges

Collectives™ on Stack Overflow

vba code taking too long (Offset) Code running in excel to populate rows columns of worksheet

2 Answers 2

Comments

Comments

Your Answer

Linked

Hot Network Questions

Collectives™ on Stack Overflow

2 Answers 2

Comments

Comments

Your Answer

Sign up or log in

Post as a guest

Linked

Related