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]

I think the last row would now be

[COLOR=#333333]lastRow.Cells(1, 1).Resize([/COLOR][COLOR=#333333]UBound(arrTranspose, 2)-[/COLOR][COLOR=#333333]LBound(arrTranspose, 2)+1[/COLOR][COLOR=#333333], [/COLOR][COLOR=#333333]UBound([/COLOR][COLOR=#333333]arrTranspose[/COLOR][COLOR=#333333], 1)-[/COLOR][COLOR=#333333]LBound([/COLOR][COLOR=#333333]arrTranspose[/COLOR][COLOR=#333333], 1)+1[/COLOR][COLOR=#333333]).value = [/COLOR][COLOR=#333333]arrTranspose[/COLOR]

 

[DynamiteHack]

I tried the edit to the lastrow line you suppled. Same error though, it does give me the option to debug. Everything looks as it should array-wise. I'll have to breakdown what that last line is doing and see if I can figure it out. Appreciate the help!!

 

[baitmaster]

My bad, I'm no longer transposing so I need to swap the dimensions that I'm using to create a range that is exactly the same size as the array

[COLOR=#333333][COLOR=#333333]lastRow.Cells(1, 1).Resize([/COLOR][/COLOR][COLOR=#333333]UBound(arrTranspose, [COLOR=#ff0000]1[/COLOR])-[/COLOR][COLOR=#333333]LBound(arrTranspose, [COLOR=#ff0000]1[/COLOR])+1[/COLOR][COLOR=#333333][COLOR=#333333], [/COLOR][/COLOR][COLOR=#333333][COLOR=#333333]UBound([/COLOR][/COLOR][COLOR=#333333][COLOR=#333333]arrTranspose[/COLOR][/COLOR][COLOR=#333333], [COLOR=#ff0000]2[/COLOR])-[/COLOR][COLOR=#333333][COLOR=#333333]LBound([/COLOR][/COLOR][COLOR=#333333][COLOR=#333333]arrTranspose[/COLOR][/COLOR][COLOR=#333333], [COLOR=#ff0000]2[/COLOR])+1[/COLOR][COLOR=#333333][COLOR=#333333]).value = [/COLOR][/COLOR][COLOR=#333333][COLOR=#333333]arrTranspose[/COLOR][/COLOR]

Arrays can be declared from any start value (think row or column number) to any end value. By default they start at base 0, but we often use 1, depending what we are doing. For example, 0 is useful if we want to include some headers outside of our data. We can change the default by adding say Option Base 1 to the very start of a code module (outside of any subs), this affects all arrays inside the module

LBound and UBound are used to find the start and end values (lower boundary, upper boundary). If the array is based at 1 then UBound returns the size of the array, but we can't rely on this so I've taken account of LBound too in the code above, by subtracting (Lbound -1)

Examples

We declare an array Arr(0 to 5, 1 to 2). Think of this as a range with 6 rows and 2 columns, where row 0 is a header row

LBound(arr,1) = 0
UBound(arr,1) = 5
LBound(arr,2) = 1
UBound(arr,2) = 2

UBound(arr, 1)-LBound(arr, 1)+1 = 5 - 0 + 1 = 6
UBound(arr, 2)-LBound(arr, 2)+1 = 2 - 1 + 1 = 2

 

[DynamiteHack]

Sorry for the delay in getting back to you. I just wanted to thank you for all the help! I was able to finally complete the project. You taught me a lot more about about manipulating arrays than I really expected. And that tip about debug.assert was down right life-changing!!

The largest file I have processed so far with the latest code inserted over 330,000 rows in just over 2 minutes. The file size was 48MB. I'm pretty happy about that considering where I started.

Thanks again for the education!!



'hack

 

[baitmaster]

No worries, thanks for the great feedback