Speeding Up For Each Loop Populating Table Rows

[DynamiteHack]

I have worked pretty hard to come up with a solution that does what I had hoped but, it is SLOOOOOW!! Just under 28,000 rows of 8 columns took 19 minutes to process. Not acceptable! LOL!

I am summarizing an application log. The process cycle creates three log lines per complete transaction. The second log line varies depending on if there was an error generated during processing. I have created an array (arrprocID) combining all of the information that I need from those three lines into one line.

The block of code below, slices and dices the array line and deposits the parts into the proper cell in the active row.

I am looking for a better approach to minimize processing time. My brute force programming skills leave a little to be desired!

Should I create arrays of pieces and then assign them to the table row? Is it the slicing and dicing that is so slow? Your thoughts and ideas are welcome!!

Thanks, DH

Dim ws As Worksheet
Dim tbl As TableObject
Dim tblMain As ListObject
Dim newRecord As ListObject
Dim lastRow As Range
Dim x As Long
Dim ltError As Long  'text splicing tools
Dim rtError As Long
Dim ltTime As Long
Dim rtTime As Long
Dim ltCon As Long
Dim value As Variant
Dim procIDCheck As String


Set ws = Worksheets("Sheet1")


ws.Activate


ws.ListObjects("tblMain").ListRows.Add


Set newRecord = ws.ListObjects("tblMain")
Set lastRow = newRecord.ListRows(newRecord.ListRows.Count).Range


With lastRow


x = 1


 'populating table and updating counters
    For Each value In arrProcID
 
        .Cells(x, 1) = Left(value, 3)
        .Cells(x, 2) = Mid(value, 5, procIDLen)
        .Cells(x, 8) = x
        If InStr(1, value, "False") > 0 Then
            'Debug.Print value
            .Cells(x, 3) = UCase(False)
        Else
            'Debug.Print value
            .Cells(x, 3) = UCase(True)
        End If
        If InStr(1, value, "ERROR") > 0 Then
            'Debug.Print value
            ltError = InStr(1, value, ",Exception=") + 11
            rtError = InStrRev(value, "Updating") - 2
            .Cells(x, 6) = Mid(value, ltError, Application.WorksheetFunction.Sum(rtError - ltError))
            ActiveCell.WrapText = False
        Else
            ltTime = InStr(1, value, "Time ")
            rtTime = InStrRev(value, "Updating") - 2
            ltCon = InStr(1, value, "Confidence") + 11
            .Cells(x, 4) = Mid(value, ltCon, 2)
            .Cells(x, 5) = Mid(value, ltTime + 5, 6)
        End If
        
        x = x + 1
    
    Next


End With

 

[baitmaster]

Your problem is that you are repeatedly interacting between Excel and VBA. Every time you write to Excel, your code is slowed. If you can do everything in VBA and minimise your interactions, you will go faster

I've therefore re-written your code to work with a dynamic VBA array. The code is untested and will probably fail on something, but it should contain enough info to demonstrate what you should be doing - which is to do EVERYTHING in VBA and then write to Excel once only

Dim arrResults()            ' create VBA dynamic array
Dim lResultCount As Long    ' counter for expanding array


Dim ws As Worksheet
Dim tbl As TableObject
Dim tblMain As ListObject
Dim newRecord As ListObject
Dim lastRow As Range
Dim ltError As Long  'text splicing tools
Dim rtError As Long
Dim ltTime As Long
Dim rtTime As Long
Dim ltCon As Long
Dim value As Variant
Dim procIDCheck As String




Set ws = Worksheets("Sheet1")


ws.Activate


ws.ListObjects("tblMain").ListRows.Add


Set newRecord = ws.ListObjects("tblMain")
Set lastRow = newRecord.ListRows(newRecord.ListRows.Count).Range


 'populating table and updating counters
    For Each value In arrProcID
        
        lResultCount = lResultCount + 1                         ' increase array size
        ReDim Preserve arrResults(1 To 8, 1 To lResultCount)    ' can only expand last dimension when using Preserve to maintain data in array
        
        arrResults(1, lResultCount) = Left(value, 3)
        arrResults(2, lResultCount) = Mid(value, 5, procIDLen)
        
        If InStr(1, value, "False") > 0 Then
            arrResults(3, lResultCount) = False
        Else
            arrResults(3, lResultCount) = True
        End If
        
        If InStr(1, value, "ERROR") > 0 Then
            ltError = InStr(1, value, ",Exception=") + 11
            rtError = InStrRev(value, "Updating") - 2
            arrResults(6, lResultCount) = Mid(value, ltError, Application.WorksheetFunction.Sum(rtError - ltError))
        Else
            ltTime = InStr(1, value, "Time ")
            rtTime = InStrRev(value, "Updating") - 2
            ltCon = InStr(1, value, "Confidence") + 11
            arrResults(4, lResultCount) = Mid(value, ltCon, 2)
            arrResults(5, lResultCount) = Mid(value, ltTime + 5, 6)
        End If
        
        arrResults(8, lResultCount) = lResultCount
        
    Next


' write results array to excel in one hit
lastRow.Cells(1, 1).Resize(UBound(arresults, 2), UBound(arrResults, 1)).value = Application.Transpose(arrResults)

 

[DynamiteHack]

I appreciate the reply, Baitmaster!

Unfortunately, I won't be able to work on this until I get home tonight. I'll let you know how I fare.
Thanks for taking the time!!

Cheers!
DH

 

[DynamiteHack]

Mr. Baitmaster! Much respect!!!

That file that took 19 minutes to process my way, takes 3 seconds with your approach. Simply astounding!!

I tried it with a file that nets 80,000+ lines and it is struggling, however. I haven't dug into the file I'm trying to process yet but, the table values are not distributing correctly across the rows. Might take a while to find the problem unless you have any ideas on finding the issue quickly. All of my arrays appear correctly when I stop the code and view them...

Smaller files work fine...

Regardless, the code you supplied is pfm!!

 

[DynamiteHack]

Been poking around a bit and I have a little more info...

arresults(1) has 80951 elements in it. The table is dimensioned correctly.

Looking at the populated table, arresults(1) populates column number 1 until it hits table row number 15,415.

After that, the remaining cells in column number 1 contain #N/A. The arresults(1) data picks up again in column 2, row 1 and continues down to row 15415. This pattern continues across all columns and is only able to use data from the first two elements in arresults. All table cells below 15,415 contain #N/A.

Stopping the code before the table populates, all arrays appear correctly dimensioned and contain expected values...I even checked the line where the fill breaks and can see nothing out of the ordinary.

I am stumped on this one. Thoughts?

Thanks,
DH

 

[baitmaster]

Glad you like it, and for future use I suggest you also read up on the use of Dictionaries, which are a great way of processing lists of unique items - see https://excelmacromastery.com/vba-dictionary/

OK I'm probably not going to be able to fix this one for you remotely, but can hopefully point you in the right direction. I'm actually surprised the code worked at all for that many results, Application.Transpose used to fail at the limits of of the .xls worksheet, which was what, 64k rows? You had to create a second array with transposed dimensions and pass the data across one piece at a time - which may work for you

Aside from that, run your code to the point at which it is failing then step through a line at a time as follows:
- Ensure the Immediate window is visible. You can use this to write values during processing, and to run individual lines of code at any time
- Ensure the Locals window is visible as this contains details of all variables that are currently active
- Add debug.print lines to write data to the Immediate window

debug.print lResultCount, value

- Add a debug.assert line to pause your code when your assertion is no longer true

debug.assert lResultCount < 15414

- Step through your code one line at a time using F8 and monitor each variable (via Locals and by hovering the cursor over it) to ensure the line of code is doing what you expect
- Ask other questions at any time by querying the Immediate window

?lResultCount {then hit enter}

The following amendments should help

[COLOR=#333333]
[/COLOR]        lResultCount = lResultCount + 1                         ' increase array size
        debug.print lResultCount, value
        debug.assert lResultCount <15414
        ReDim Preserve arrResults(1 To 8, 1 To lResultCount)    ' can only expand last dimension when using Preserve to maintain data in array

Your code will report your two key variables to the Immediate window during processing, then pause at the loop before you start to encounter problems. Then step through using F8 and see what happens. Note: the yellow highlighted row is the next line to run, and variables will only change after that has happened

 

[DynamiteHack]

This is awesome! I had never bothered to lookup what debug.assert meant. Sure wish I would have!!
Thanks very much for the information. Of course, work will delay my playing around with this but I'll let you know what I find!

Again, thank you very much!!

DH

 

[DynamiteHack]

Well, this is much deeper into Excel than I ever thought I would go. It's kinda fun, though.

I added the debug.print and debug.assert as you suggested. Worked like a charm and I now have a new debugging strategy so, I thank you for that!

I probably should have mentioned earlier that I am using the version O365 MSO version of Excel. 32-bit.

What I found going though the code line by line after the assert stopped it was, the array continued to build as expected. It appears that the application.transpose is the culprit. From what I've read so far, the 65,536 row limit is what's biting me.

I have a total of 80,951 rows to populate. It just so happens that 80,951 - 65,536 = 15,415. The exact number of rows that were populated, across all 8 columns!!

I'm sure I'll never understand what prompted the the cells to fill in as they did. It probably doesn't matter, at this point. It is what it is!

I have to regroup and figure out a way that will avoid this problem. You seemed to suggest that I could create multiple arrays and transpose them into the table a chunk at a time. That seems like my most painless approach. Maybe cap the arrays at 60,000 rows? Since I won't know, at runtime, how many arrays I'll need I guess a loop of some sort will be required...can I dim a variable on the fly??

I will probably try that approach tonight. I have no concept of using a Dictionary. Would I transpose the array into a dictionary and then populate the table from the Dictionary? Or, ditch the arrays altogether and use a dictionary?

Again, your thoughts are looked forward to!!

Thanks,
DH

 

[baitmaster]

At some point you realise you can do much more work much quicker and more accurately using VBA than Excel, and you also gain a far deeper understanding of the Excel Object Model which increases your knowledge further. Before you know it you can spend half your day drinking coffee and chatting, and still knock out far better work than any of your colleagues :D

I'm entirely unsurprised it was application.transpose that caused the problem... you need a different approach to transposing arrays, which is easy enough. The following approach can be added directly to your existing code if you want

' create the transposed array, and resize it to Y,X cells where original is X,Y cells
' we use Ubound to get upper boundary size of the dimension stated (1 or 2 in this code) and Lbound to get lower boundary size, which is 0 by default but is often 1

Dim arrTranspose()
ReDim arrTranspose(LBound(arrResults, 2) To UBound(arrResults, 2), LBound(arrResults, 1) To UBound(arrResults, 1))


' loop through all cells of arrResults and pass to arrTranspose
Dim i As Integer, j As Integer
For i = LBound(arrResults, 1) To UBound(arrResults, 1)
    For j = LBound(arrResults, 2) To UBound(arrResults, 2)
        arrTranspose(j, i) = arrResults(i, j)
    Next j
Next i

...at which point you simply work with arrTranspose instead of arrResults. If I were you I'd consider turning this into a standalone function so you can use it any time you want, as many times as you want, without having to declare umpteen arrays in advance

I pasted a sample dictionary for someone else at https://www.mrexcel.com/forum/excel-questions/1101600-vba-loop.html, which should be enough to demonstrate basic use. They're not quite the same as arrays, they have different features and limitations, but are still extremely useful at the right time. This is not that time - but you'll benefit from knowing about them so read up and have a play

 

[DynamiteHack]

Didn't get much time today to play with this today. I got the loop to work to transpose the array. The arrResults array looks good. I can't seem to get it to populate the table however without generating a runtime error, number 1004 to be exact. A search says that's related to the range not being created. The lastrow seems to be there. Not sure how I would edit your last line to populate the table...I think it's close!