Delete rows, speed up?

shadow12345

shadow12345

Well-known Member
Joined
May 10, 2004
Messages
1,238
Hi all,

I am using the below code to delete rows from an excel 2007 sheet.... trouble is it take forever! I have 38000 + rows.

Is there anything I can do to speed up more?

code/ Sub Firstdel()

Dim i As Long
Application.ScreenUpdating = False
For i = Cells(Rows.Count, 1).End(xlUp).Row To 4 Step -1
If Range("AB" & i).Value = "Delete" Then Range(i & ":" & i - 1).Delete Shift:=xlUp
Next i


End Sub \code
 
Last edited:
Sort by date Sort by votes
How big a data range we talking here?

I tested 40k rows with Delete every 4th row and it took about 50 seconds
 
Upvote 0

Excel Facts

What is the shortcut key for Format Selection?
Ctrl+1 (the number one) will open the Format dialog for whatever is selected.
Hi Shadow

If you have more than 8192 areas you are trying to delete, it will fail, so you could still use Autofilter but you need to loop thru the results:

Code: 
Sub Macro1()
Dim xlCalc As xlCalculation
Dim lst As Long, i As Long
Dim r As Range

With Application
  xlCalc = .Calculation
  .Calculation = xlCalculationManual
ENd With

lst = Range("AB" & Rows.Count).End(xlUp).Row
    Range("$A$3:$AC$" & lst).AutoFilter
    Range("$A$3:$AC$" & lst).AutoFilter Field:=28, Criteria1:="Delete"

Set r = ActiveSheet.Autofilter.Range.Offset(1)

With r
  for i = .Rows.Count to 1 Step -1000
   If i > 1000 Then
      .Range("A" &  i,.Cells(i-1000,"A")).SpecialCells(xlCellTypeVisible).EntireRow.Delete
   Else
      .Range("A" &  i,.Cells(1,"A")).SpecialCells(xlCellTypeVisible).EntireRow.Delete
   End If
  Next i
End With

Activesheet.AutofilterMode = False
Application.Calculation = xlCalc
End Sub
 
Upvote 0
Hi all,

sorry i got a bit of a side track running on this one (few days off work... very nice)

This seems to work.

I am using anything up to 150k rows and deleting about half of that... ish. I am running the above code now and trying that one out.
 
Upvote 0
Hoping to piggyback off of this thread.

Objective: I’m trying to extract information from the “JE” tab based on certain criteria without altering that tab. So, I copy the relevant info to the “FAR” tab and manipulate that data. In trying to remove data that does not match my criteria, I’m running into the problem of selecting more than 8192 non-contiguous cells. I’ve created a loop and using the autofilter method, but it takes over 4 minutes to run. Can you suggest anything to help speed this process up?

Sample data from JE Tab:
http://www.filefactory.com/file/c2e51d6/n/Sample_Data.xlsx


I’m using Excel 2007. The complete data set has roughly 75,000 rows. Thank you in advance for your help.


Code: 
Sub FAR()
Application.ScreenUpdating = False
Application.DisplayAlerts = False

Sheets.Add
ActiveSheet.Name = "FAR"

Sheets.Add
ActiveSheet.Name = "FARFinal"

With Sheets("JE")
    .Activate
    .Rows("1:1").Copy Destination:=Sheets("FARFinal").Rows("1:1")
    .Rows("1:1").Find(What:="PERIOD", SearchOrder:=xlByRows).EntireColumn.Copy Destination:=Sheets("FAR").Range("A1")
    .Rows("1:1").Find(What:="REF", SearchOrder:=xlByRows).EntireColumn.Copy Destination:=Sheets("FAR").Range("B1")
    .Rows("1:1").Find(What:="ENTITYID", SearchOrder:=xlByRows).EntireColumn.Copy Destination:=Sheets("FAR").Range("C1")
    .Rows("1:1").Find(What:="ACCTNUM", SearchOrder:=xlByRows).EntireColumn.Copy Destination:=Sheets("FAR").Range("D1")
    .Rows("1:1").Find(What:="AMT", SearchOrder:=xlByRows).EntireColumn.Copy Destination:=Sheets("FAR").Range("E1")
End With

LastRow = Sheets("FAR").Range("A1").End(xlDown).Row
Sheets("FAR").Activate
Sheets("FAR").Range("A1").End(xlToRight).Offset(0, 1) = "Special"
Sheets("FAR").Range("A1").End(xlToRight).Offset(1, 0).Resize(LastRow - 1, 1).FormulaR1C1 = "=RC[-5]&RC[-4]&RC[-3]"
Sheets("FAR").Cells(2, 6).Resize(LastRow, 1).Formula = Sheets("FAR").Cells(2, 6).Resize(LastRow, 1).Value
Sheets("FAR").Range("A1").End(xlToRight).Offset(0, 1) = "Type"
Sheets("FAR").Range("A1").End(xlToRight).Offset(1, 0).Resize(LastRow - 1, 1).FormulaR1C1 = "=if((Left(Mid(RC[-3],3,500),2)+0>=15)*(Left(Mid(RC[-3],3,500),2)+0<=17),""FA"",if(Left(Mid(RC[-3],3,500),1)+0>=4,""IS"",""Error""))"
MyDataRange = Sheets("FAR").Range("A1").CurrentRegion.Address

Sheets("FAR").Range("A1").AutoFilter Field:=7, Criteria1:="=Error"


MsgBox Format(Now - StartTime, "hh:mm:ss")
StartTime = Now

'Beg************this part takes 4:21*************

StarterCell = 2
Increment = 8000
For Cycle = 1 To Round(LastRow / Increment, 0)
StarterCell = Range(Cells(StarterCell, 1), Cells(StarterCell + Increment, 1)).SpecialCells(xlCellTypeVisible)(1).Row
Range(Cells(StarterCell, 5), Cells(StarterCell + Increment, 5)).SpecialCells(xlCellTypeVisible).EntireRow.Delete 
Next Cycle

'End************this part takes 4:21*************

MsgBox Format(Now - StartTime, "hh:mm:ss")
StartTime = Now


'************Remaining Code Below*************



Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub


Thanks,
Brenner
 
Upvote 0
Hi Brenner

I would definitely try turning Calculation to Manual during the duration of the macro eg:

Code: 
Application.Calculation = xlCalculationManual

'rest of code

Application.Calculation = xlCalculationAutomatic
 
Upvote 0
You must log in or register to reply here.

Similar threads

E
  • Question Question
Can I speed this simple routine up?
2
Replies
10
Views
302
EssKayKay
E
G
  • Solved
Skip Row When Column Word Meet
2
Replies
14
Views
431
Peter_SSs
Peter_SSs
Guinaba
  • Question Question
Tunning a VBA macro
Replies
1
Views
119
Skyybot
Skyybot
J
  • Question Question
Copying Rows Based on Column Value
Replies
1
Views
213
jolivanes
jolivanes
W
  • Solved
Looking For Tips To Improve My VBA
Replies
8
Views
253
who am i
W

Forum statistics

Threads
1,225,155
Messages
6,183,212
Members
453,151
Latest member
Lizamaison

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top