Speed up code Removing duplicate rows

I

Ixtreme

I have a sheet with more than 4,000 rows which is expanding).

Column D contains dates
Column E contains employees
Column F contains ordernumber

After running a VBA script that appends rows to my sheet, I want to
remove rows where Column D and Column E are equal while column F is
empty. Currently I have received a script from Joel, but this takes
more than 10 minutes to finish. Is there a better / quicker way to do
what I want?


Sub Removed_Duplicates()

LastRow = Cells(Rows.Count, "D").End(xlUp).Row

Remove = False
LoopCounter = 1
Do While LoopCounter <= LastRow
If IsEmpty(Cells(LoopCounter, "F")) Then

MyDate = Cells(LoopCounter, "D").Value
Employee = Cells(LoopCounter, "E").Value

For RowCount = 1 To LastRow
If RowCount <> LoopCounter Then

If (Cells(RowCount, "D").Value = MyDate) And _
(Cells(RowCount, "E").Value = Employee) Then

Remove = True
End If

End If

Next RowCount

End If

If Remove = True Then
Rows(LoopCounter).Delete
Remove = False
Else
LoopCounter = LoopCounter + 1
End If
Loop
End Sub
 
J

John Bundy

Main thing is to turn off screen updating and if you have formulas there turn
off calculations, try this:

Sub Removed_Duplicates()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual


LastRow = Cells(Rows.Count, "D").End(xlUp).Row

Remove = False
LoopCounter = 1
Do While LoopCounter <= LastRow
If IsEmpty(Cells(LoopCounter, "F")) Then

MyDate = Cells(LoopCounter, "D").Value
Employee = Cells(LoopCounter, "E").Value

For RowCount = 1 To LastRow
If RowCount <> LoopCounter Then

If (Cells(RowCount, "D").Value = MyDate) And _
(Cells(RowCount, "E").Value = Employee) Then

Remove = True
End If

End If

Next RowCount

End If

If Remove = True Then
Rows(LoopCounter).Delete
Remove = False
Else
LoopCounter = LoopCounter + 1
End If
Loop
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top