Loop Referencing Sheet Gets Progressively Slower

[SomeKindaGreekGod]

I've had a very intriguing problem for a long time now, and am really hoping someone here can offer me some insight and hopefully a solution.

Here's the deal: I have a simple function that pulls in a single cell value, one per row, stores it in a property of a custom type, and then does a little more processing based on the value.

The custom type is GR, the property is CGID.

With Worksheets("Sheet1")
            GR.CGID = UCase$(Trim$(.Range("CGID")(rw).Text))
End With

It runs fine with no noticeable performance changes up to around 10,000 records, but beyond that, it gets progressively slower and slower and slower until, at about the 20,000 record mark, it's processing at about 1/10 the speed it started at! (100 recs/sec instead of 1000+)

For testing purposes, all the cell values are the same, and are a small string value.

I know that hitting the sheet from VBA is time-intensive itself, so of course it makes sense that if I had two calls to the sheet, it would take twice as long to run the function as if I have just one. But this issue where the processing speed decreases as time goes on leads me to think there's some kind of garbage collection or memory allocation problem that I hope can be solved.

So to all the other gurus out there, any ideas? Any help is much appreciated! I'm not looking for ways to speed up the code necessarily, I really just want it to go the same speed for all 20,000 records.

 

[SomeKindaGreekGod]

If anyone has any ideas for how I can either avoid using .Text or how to keep it from hogging memory (I assume), then I'd love to hear them! The requirement is just that some cells I need to get what the cell looks like rather than it's ultimate value.

So here was my quick solution: In the few columns where I might need the .Text property, I added an extra conditional to check if the NumberFormat was something other than "General" or "@" (text) and only if true, then use the .Text property, otherwise get the value of the cell.

This bit of overhead seemed to even out the processing to about equal intervals, and it ran the entire process more than 2x faster than without the conditional and accessing the .Text property for each row! It's not perfect, and I'm still intrigued as to why the use of the property gets progressively slower, but at least I have a workable solution.

 

[Weaver]

This won't help avoid using .text, but it might be quiker

Sub checkDupes()
    startRow = 1
    lastRow = 42
    Set sd = CreateObject("scripting.dictionary")
    With Worksheets("sheet1")
        For rw = startRow To lastRow
            v = UCase$(Trim$(.Cells(rw, "C").Text))
            If sd.exists(v) Then
                'do whatever you need to do with duplicates
                .Cells(rw, "C").Interior.ColorIndex = 3
            Else
                sd.Add v, 1
            End If
        Next rw
    End With
End Sub

Put some repeating data in column C in sheet1 and give it a test. If it does what you expected, I imaging you'll be able to adapt it.

HTH

 

[SomeKindaGreekGod]

Thanks Weaver, I've never heard of the dictionary object before. Is there any particular reference that's needed for that dictionary object? I'm having to design this for both Excel 2007 and 2003 users and so I need to have cross-compatible code that won't require people to hunt for references.

 

[Weaver]

I used late binding, so it shouldn't be an issue.

PS this ought to work on sorted or unsorted data.

 

[SomeKindaGreekGod]

It's certainly the more elegant and intuitive solution, even if I'd never have found it on my own. I'll give it a try and see if there's any significant performance difference.

 

[SomeKindaGreekGod]

This won't help avoid using .text, but it might be quiker

Sub checkDupes()
    startRow = 1
    lastRow = 42
    Set sd = CreateObject("scripting.dictionary")
    With Worksheets("sheet1")
        For rw = startRow To lastRow
            v = UCase$(Trim$(.Cells(rw, "C").Text))
            If sd.exists(v) Then
                'do whatever you need to do with duplicates
                .Cells(rw, "C").Interior.ColorIndex = 3
            Else
                sd.Add v, 1
            End If
        Next rw
    End With
End Sub

Put some repeating data in column C in sheet1 and give it a test. If it does what you expected, I imaging you'll be able to adapt it.

HTH

Darn, I really like that solution; it makes sense, but I don't think I can use it since it means that the first instance won't be flagged. The ID may be the same, but other fields may be different, so there's nothing to determine that the second ID found is the record that's unneeded, both may need to be changed.

My code is also setting an error field to true so that after I check for dupes, all dupes found are at the top of the record set, and are sorted by ID as a second sort level.

 

[Weaver]

If my code doesn't fit your needs, going back to your original solution, why don't you store the value from the previous iteration, since that would be one less .text extraction to perform on each subsequent iteration.

 

[SomeKindaGreekGod]

I'll play with it some more. The other option is to loop through the recordset twice, since the second time all the dictionary items will be there at least once. This actually was still incredibly fast, I think less than a second for running through 20k records two times, but that seems more rigged than I typically prefer to code.

Edit: this only would work in some instances depending on the code flow, since obviously I wouldn't want to flag everything as a duplicate.

So I need to figure out if I can use the dictionary object, but still be able to flag all n duplicate records and not just n-1.

 

[Weaver]

A small mod and you can populate the dictionary table with a count of how often each item appears. Then on the second pass, you can apply the shading

Sub checkDupes()
    startrow = 1
    lastrow = 42
    Set sd = CreateObject("scripting.dictionary")
    With Worksheets("sheet1")
        For rw = startrow To lastrow
            v = UCase$(Trim$(.Cells(rw, "C").Text))
            If sd.exists(v) Then
                sd.Item(v) = sd.Item(v) + 1
            Else
                sd.Add v, 1
            End If
        Next rw
        For rw = startrow To lastrow
            v = UCase$(Trim$(.Cells(rw, "C").Text))
            If sd.Item(v) > 1 Then
                .Cells(rw, "C").Interior.ColorIndex = 3
            End If
        Next
    End With
End Sub

PS this covered 10000 test records in just under 1 sec.

 

[SomeKindaGreekGod]

Awesome! That's nifty. Don't know what I'd do without Google, Mr. Excel, and good people like Chirp and Weaver!

By the way, I asked the .Text property slowdown question on Microsoft Answers, hopefully I'll get some insight on that as well:
The .Text Property Causes Code to Execute Slower and Slower