??.Delete Shift:=xlUp...why is this slow?? Pls Help!

[samsonjonesuk]

Hi Board

Been a while since I was last here and this is my problem if anyone can help.

I have a simple deduplication macro (below) which runs through a worksheet and deletes subsequent rows via a loop.

The macro begins very efficiently and deletes very quickly, however this then slows down to a virtual halt and after debugging I have found that the line which contains this :-Rows(z & ":" & z + y - 1).Delete Shift:=xlUp
is hanging for ages until it actually decides to delete the selected area.

Does anyone know why this is, I have turned off screen updating and automatic calculation and it is still as slow.

Any help would be greatly appreciated.

Sean
__________________________________

Public x As Integer, y As Integer, data As String, z As Integer


'deduplicate open projects spreadsheet

Sub A_dedup()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
x = 2
y = 0
z = 0
Sheets("Open Projects").Select
Cells.Select
Selection.sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range("D2") _
, Order2:=xlAscending, header:=xlYes, OrderCustom:=1, MatchCase:= _
False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
:=xlSortNormal
Do
Sheets("Open Projects").Range("A" & x).Select
Sheets("Open Projects").Range("AE" & x).Value = "=VLOOKUP(B" & x & ",'Comp List'!A$2:B$254,2,0)"
data = Sheets("Open Projects").Range("A" & x).Value

If Sheets("Open Projects").Range("A" & x + 1) = data Then
If z = 0 Then
z = x + 1
End If

y = y + 1
Else

If y < 1 Then

Else
Rows(z & ":" & z + y - 1).Delete Shift:=xlUp
x = z - 1
z = 0
y = 0
End If

End If
x = x + 1
Loop While Range("A" & x).Value <> ""

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

End Sub

 

[Leonard of Quirm]

Samson,
I have also found in the past that after making multiple deletions, Excel really slows down.

I find it is best when operating a method such as this to go through my target range identifying rows to be deleted and then deleting them all in one go right at the end of the procedure. It works much more efficiently.
This is the code I use:

Sub Remove_Empty_Rows 

Dim NullRange As Range 
Set NullRange = Nothing 

For i = 1 To ActiveSheet.UsedRange.Rows.Count 
    If Range("A" & i).Value = "" Then    'If cell in column A (for simplicity) is empty, then add to NullRange. 
     If NullRange Is Nothing Then     'If NullRange were non-empty to start, this If could be removed leaving the Else action as the only one to perform. 
         Set NullRange = (Cells(i, 1)) 
     Else 
         Set NullRange = Union(NullRange, Cells(i, 1)) 
     End If 
    End If 
Next 

If Not (NullRange Is Nothing) Then 
    NullRange.EntireRow.Delete 'Delete the rows which satisfy the condition. 
End If 

End Sub

You should be able to amend this to suit your requirements. Just change the "test" at the start as appropriate (e.g. rather than checking for empty cells, check for cells with value equal to 0).

If you need any part of the procedure explained, post back and I'll try to help out more.

Matt

 

[samsonjonesuk]

Thanks Matt....Star

Matt you are a genius.

Worked a treat and taught me a few things on structure and new commands.

Thanks mate


Sean