CODEWITHSUNDEEP
excelvba
learnTech
learnTech

Reputation: 45

VBA sub taking long time to execute

I have 3000 rows of data in sheet1 , this data I need to compare sheet2. before starting comparison I am finding employee who is not available in sheet 2. if employee not found in Sheet2 I am deleting that record in sheet1 and shifting cells up. Deleting not found employee record and shifting cells up is taking long time. I have placed screen updating = false and calculation mode to xlmanual. still it is taking long time.

how to speed up this code execution. below is the sample code:

For Each rngCell In Sheets("Sheet1").Range("AE3:AE" & lastRow)
    If WorksheetFunction.CountIf(Sheets("Sheet2").Range("V2:V" & lastRow), rngCell) = 0 Then
        Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1) = rngCell                        
        Sheets("Sheet1").Range("AE" & rngCell.Row & ":" & "AR" & rngCell.Row).Delete Shift:=xlUp
        
    End If
Next

Upvotes: 0

Views: 121

Answers (4)

spioter
spioter

Reputation: 1870

On the rows you need to delete, instead add a column with a formula to determine existence of some ID on another sheet (like VLOOKUP or COUNTIF ). Then you can just filter the not found rows away, or if you must delete, use vba to sort them to bottom then filter then delete.

Upvotes: 0

chris neilsen
chris neilsen

Reputation: 53126

Your code is slow for three primary reasons:

  1. It makes many reads from individual cells. This is slow
  2. It does many writes to individual cells. This is even slower.
  3. It does many Deletes of a few cells on individual rows. This is even slower still.

My suggestions to improve speed:

  1. Read the data to be processed into Variant Arrays, once, before the loop

  2. Loop the array rather than a range

  3. Build a new array of data as you loop. Place the array onto a sheet once, at the end of the loop.

  4. Build a range reference to cells to be deleted as you loop (that is, don't delete in the loop). Delete the built Range in one go after the loop.

There are lots of examples of each of these techniques on SO

Caveat for other readers who may want to scale this:

Building a range of non-contiguous sub ranges using Union does not scale well. The time taken to add another range using Union increases exponentially as the number of non-contiguous sub ranges in the range increases. Up to about 1000 sub ranges this won't be noticable. Once you get to 10's or 100's of thousands the slowdown is significant

Upvotes: 2

JMP
JMP

Reputation: 4467

This reference:

Sheets("Sheet2").Range("V2:V" & lastRow)

doesn't change it's value through the entire loop, but you recalculate it every iteration.

Store it in a variable outside the loop instead:

Dim sheet2Vlastrow As Range
Set sheet2Vlastrow = Sheets("Sheet2").Range("V2:V" & lastRow)

For Each rngCell In Sheets("Sheet1").Range("AE3:AE" & lastRow)
    If WorksheetFunction.CountIf(sheet2Vlastrow, rngCell) = 0 Then
        Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1) = rngCell                        
        Sheets("Sheet1").Range("AE" & rngCell.Row & ":" & "AR" & rngCell.Row).Delete Shift:=xlUp            
    End If
Next

Upvotes: 0

pykam
pykam

Reputation: 1481

It is never a good idea to delete during an iteration. If you do have to delete, its better to delete from the bottom.

You can use the sample code below to iterate from the last row up to the first.

For x = lastRow To 3 Step -1
   rngCell = Sheets("Sheet1").Range("AE3" & x)
   If WorksheetFunction.CountIf(Sheets("Sheet2").Range("V2:V" & lastRow), rngCell) = 0 Then
        Sheets("Sheet3").Range("A" & Rows.Count).End(xlUp).Offset(1) = rngCell                        
        Sheets("Sheet1").Range("AE" & rngCell.Row & ":" & "AR" & rngCell.Row).Delete Shift:=xlUp   
    End If
Next x

Upvotes: 0

Related Questions