CODEWITHSUNDEEP
excelvbaruntime
ByteMiser255
ByteMiser255

Reputation: 11

VBA routine taking forever to run

There is a report in Oracle that I dump into Excel but it has terrible formatting. There are thousands of individual accounts and each account has one or more lines of data. I need to do intensive data manipulation on the report to whip it into shape such that there is any utility to it whatsoever. This is the way the report is laid out (the "Rows of data" lines vary for each record).

Header1
Header2
Row of data
Row of data
Row of data
----------------------
summary data
summary data

The problem is that these records can not be filtered by the headers because the data is stacked vertically. So, after I have stripped out all the extraneous rows that I don't want, leaving a delimiting blank row between each record (a primitive method of enabling exiting the inner loop), I run a very simple VBA routine I created. For each 'Row of Data', the headers print to a column to the right on the same row.

I segment the data into two or more sets because there might be over 60K lines and this is to prevent a run time error "6".

Row of data  Header1  Header2
Row of data  Header1  Header2
Row of data  Header1  Header2
----------------------
summary data
summary data

The following routine used to run at lightening speed - less than 30 seconds, now after a change from Office 2016 to Office 365 desktop, the same routine runs painfully slow. It can take a half hour to run one segment. I am baffled. Can someone tell me what might be causing this and what I can change with this routine to make it run faster?


Sub UnifyRowData()
Dim i As Integer
Dim TtlRows As Integer

TtlRows = Cells(Rows.Count, 1).End(xlUp).Row
i = 0
Do Until i > TtlRows
i = i + 1
Heading1 = Cells(i, 1)
Heading2  = Cells(i + 1, 1)
Heading3 = Cells(i + 2, 1)
    Do
    Cells(i, 3).Value = Heading1
    Cells(i, 4).Value = Heading2
    Cells(i, 5).Value = Heading3
    i = i + 1
    Loop Until IsEmpty(Cells(i, 1))
  Loop

End Sub

`

I don't know what I can change. I've read about screen updating causing long run times but someone would need to explain to me why that would slow down this routine that used to run at lightening speed.

Upvotes: 1

Views: 55

Answers (1)

Tim Williams
Tim Williams

Reputation: 166241

This should be faster, using an array to work on the data:

Sub UnifyRowData()
    Dim i As Long, ws As Worksheet, h1, h2, h3
    Dim TtlRows As Long, arr, rngData As Range
    
    Set ws = ActiveSheet
    'get the data range (including additional columns to be populated)
    Set rngData = ws.Range("A1", ws.Cells(ws.Rows.Count, 1).End(xlUp)).Resize(, 5)
    arr = rngData.Value        'read as array
    TtlRows = UBound(arr, 1)   '# of rows of data
    
    i = 0
    Do While i <= TtlRows
        i = i + 1
        h1 = arr(i, 1)
        h2 = arr(i + 1, 1)
        h3 = arr(i + 2, 1)
        Do
            arr(i, 3) = h1
            arr(i, 4) = h2
            arr(i, 5) = h3
            i = i + 1
            If i > TtlRows Then Goto done 'exit loops if at end of array
        Loop Until Len(arr(i, 1)) = 0
    Loop
done:
    rngData.Value = arr 'write the array back to the sheet

End Sub

Upvotes: 2

Related Questions