• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

How to make my macros run faster

Hi,

Does anyone can help me make my macros run fast.
It used to function fast but as more and more info is coming, it's taking me ages
to wait before it finished.
Thanks.


Code:
Sub Delete_Dups_Keep_Last()
Dim i As Long
Dim j As Long
Dim ROW_DELETED As Boolean
i = 1  'start on first row

Worksheets("DRAWINGS (submitted to LTA)").Range("A1:O3500").Copy Destination:=Worksheets("Summary").Range("a1")

Application.ScreenUpdating = False
Do While i <= ActiveSheet.UsedRange.Rows.Count
  ROW_DELETED = False
  For j = i + 1 To ActiveSheet.UsedRange.Rows.Count
  If Cells(i, 10) = Cells(j, 10) Then
  Rows(i).Delete
  ROW_DELETED = True
  Exit For
  End If
  Next j
  If Not ROW_DELETED Then i = i + 1
Loop
Application.ScreenUpdating = True
End Sub
 
Last edited by a moderator:
Dear Narayan,

Basically when I run this macro it takes me ~7minutes before it finishes.
Its like same time I will get when I do manually.
Is there a way where I can make this run faster?
Thanks.
 
Michelle

Can you describe what the macro should do to the worksheet when it runs
or
can you provide a sample file so we can see what data it has to work with?
 
So you want to remove all the duplicates just leaving the last one
Is that correct ?

Are there any other ways of identifying the fields to delete or keep
ie: Color, Strike through or other field values?

The code is slow as it is going through 3000 loops up to 3000 times decreasing by 1 for each initial loop
 
So you want to remove all the duplicates just leaving the last one
Is that correct ?

Are there any other ways of identifying the fields to delete or keep
ie: Color, Strike through or other field values?

The code is slow as it is going through 3000 loops up to 3000 times decreasing by 1 for each initial loop

Hi Hui,
I prefer to keep the coloring and striking so as it's easier to identify each one of them.
Would it be faster if there is no condition formatting?
Thanks.
 
Could you try the following on a copy of your workbook

Code:
Sub Delete_Dups_Keep_Last_2()

Worksheets("DRAWINGS (submitted to LTA)").Range("A1:O3200").Copy Destination:=Worksheets("Summary").Range("a1")

'Application.ScreenUpdating = False
ActiveSheet.Range("A1:O3200").RemoveDuplicates Columns:=Array(10), Header:=xlYes

'Application.ScreenUpdating = True
End Sub
 
Could you try the following on a copy of your workbook

Code:
Sub Delete_Dups_Keep_Last_2()

Worksheets("DRAWINGS (submitted to LTA)").Range("A1:O3200").Copy Destination:=Worksheets("Summary").Range("a1")

'Application.ScreenUpdating = False
ActiveSheet.Range("A1:O3200").RemoveDuplicates Columns:=Array(10), Header:=xlYes

'Application.ScreenUpdating = True
End Sub

Hi Hui,

I tried copying it but it's not getting the last row of the duplicates.
Instead, it's giving all the duplicates.
Thanks.
 
Back
Top