I currently have a macro that I use to delete a record if the ID doesn’t exist in a list of ID’s I created from an XML document. It does work like I want it to, however I have over 1000 columns in the spreadsheet (one for each day of the year until end of 2015) so it takes ages to delete the row and it can only do 1 or 2 before it says “Excel ran out of resources and had to stop”. Below is the code I’m using for the macro, is there another way I can do this so that Excel doesn’t run of of resources?
Sub deleteTasks() Application.ScreenUpdating = False Dim search As String Dim sheet As Worksheet Dim cell As Range, col As Range Set sheet = Worksheets("misc") Set col = sheet.Columns(4) ActiveWorkbook.Sheets("Schedule").Activate ActiveSheet.Range("A4").Select ActiveSheet.Unprotect ActiveSheet.Range("A:C").EntireColumn.Hidden = False Do While ActiveCell.Value <> "" search = ActiveCell.Value Set cell = col.Find(What:=search, LookIn:=xlValues, _ LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _ MatchCase:=False, SearchFormat:=False) If cell Is Nothing Then 'If the taskID is not in the XML list Debug.Print "Deleted Task: " & ActiveCell.Value Selection.EntireRow.Delete End If ActiveCell.Offset(1, 0).Select 'Select next task ID Loop ActiveSheet.Range("A:B").EntireColumn.Hidden = True ActiveSheet.Protect End Sub
After trying lots of different options, including all the answers listed below. I have realized that whatever the method is, deleting a row with ~1100 columns is going to take a while on my average laptop (2.20 Ghz, 4GB RAM). Since the majority of the rows are empty I have found alternative method which is a lot faster. I just clear the cells which contain data (A:S) and then resize the table to remove the row where I just deleted the data from. This end result is exactly the same as
entireColumn.Delete. Below is the code I’m using now
'New method - takes about 10 seconds on my laptop Set ws = Worksheets("Schedule") Set table = ws.ListObjects(1) Set r = ws.Range("A280:S280") r.Clear table.Resize Range("A3:VZ279")
Using anything involving
EntireColumn.Delete or just manually selecting the row and deleting it takes about 20-30 seconds on my laptop. Of course this method only works if your data is in a table.
The short answer:
Use something like
ActiveSheet.Range(DelStr).Delete ' where DelStr = "15:15" if you want to delete row 15 ' = "15:15,20:20,32:32" if you want to delete rows 15,20 and 32
The long answer:
Important: If you have ~ 30 / 35 rows to delete, the following code works very efficiently. Beyond which it would throw up an error. For code to handle arbitrary number of rows efficiently see the very long answer below this.
If you have a function which lets you list out which rows you want to delete, try the code below. This is what I use to very efficiently delete multiple rows with minimum overhead. (the example assumes that you’ve obtained the rows you need to delete through some program, here I manually feed them in):
Sub DeleteRows() Dim DelRows() As Variant ReDim DelRows(1 To 3) DelRows(1) = 15 DelRows(2) = 18 DelRows(3) = 21 '--- How to delete them all together? Dim i As Long For i = LBound(DelRows) To UBound(DelRows) DelRows(i) = DelRows(i) & ":" & DelRows(i) Next i Dim DelStr As String DelStr = Join(DelRows, ",") ' DelStr = "15:15,18:18,21:21" ' ' IMPORTANT: Range strings have a 255 character limit ' See the other code to handle very long strings ActiveSheet.Range(DelStr).Delete End Sub
The (very long) efficient solution for arbitrary number of rows and benchmark results:
Here are the benchmark results obtained by deleting rows (Time in seconds vs. no. of rows).
The rows are on a clean sheet and contain a volatile formula in the D column from D1:D100000
i.e. for 100,000 rows, they have a formula
The code is long and not too pretty, but it splits the
DelStr into 250 character substrings and forms a range using these. Then the new
DeleteRng range is deleted in a single operation.
The time to delete may depend on the contents of the cells. The testing/benchmarking, in congruence with a bit of intuition suggests the following results.
- Sparse rows/empty cells delete fastest
- Cells with values take somewhat longer
- Cells with formulas take even longer
- Cells which feed into formulas in other cells take longest as their deletion triggers the
Sub DeleteRows() ' Usual optimization ' Events not disabled as sometimes you'll need to interrupt ' You can optionally keep them disabled Application.Calculation = xlCalculationManual Application.ScreenUpdating = False ' Declarations... Dim DelRows() As Variant Dim DelStr As String, LenStr As Long Dim CutHere_Str As String Dim i As Long Dim MaxRowsTest As Long MaxRowsTest = 1000 ' Here I'm taking all even rows from 1 to MaxRowsTest ' as rows to be deleted ReDim DelRows(1 To MaxRowsTest) For i = 1 To MaxRowsTest DelRows(i) = i * 2 Next i '--- How to delete them all together? LenStr = 0 DelStr = "" For i = LBound(DelRows) To UBound(DelRows) LenStr = LenStr + Len(DelRows(i)) * 2 + 2 ' One for a comma, one for the colon and the rest for the row number ' The goal is to create a string like ' DelStr = "15:15,18:18,21:21" If LenStr > 200 Then LenStr = 0 CutHere_Str = "!" ' Demarcator for long strings Else CutHere_Str = "" End If DelRows(i) = DelRows(i) & ":" & DelRows(i) & CutHere_Str Next i DelStr = Join(DelRows, ",") Dim DelStr_Cut() As String DelStr_Cut = Split(DelStr, "!,") ' Each DelStr_Cut(#) string has a usable string Dim DeleteRng As Range Set DeleteRng = ActiveSheet.Range(DelStr_Cut(0)) For i = LBound(DelStr_Cut) + 1 To UBound(DelStr_Cut) Set DeleteRng = Union(DeleteRng, ActiveSheet.Range(DelStr_Cut(i))) Next i DeleteRng.Delete Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True End Sub
The code to generate the formulas in a blank sheet is
Sub FillRandom() ActiveSheet.Range("D1").FormulaR1C1 = "=SIN(RAND())" Range("D1").AutoFill Destination:=Range("D1:D100000"), Type:=xlFillDefault End Sub
And the code to generate the benchmark results above is
Sub TestTimeForDeletion() Call FillRandom Dim Time1 As Single, Time2 As Single Time1 = Timer Call DeleteRows Time2 = Timer MsgBox (Time2 - Time1) End Sub
Note: Many thanks to brettdj for pointing out the error which gets thrown when the length of
DelStr exceeding 255 characters. It seems to be a known problem and as I painfully found out, it still exists for Excel 2013.
This code uses AutoFilter and is significantly faster than looping through rows.
I use it daily and it should be pretty easy to figure out.
Just pass it what you’re looking for and the column to search in.
You could also hard-code the column if you want.
private sub PurgeRandy Call FindDelete("F", "Randy") end sub
Public Sub FindDelete(sCOL As String, vSearch As Variant) 'Simple find and Delete Dim lLastRow As Integer Dim rng As Range Dim rngDelete As Range Range(sCOL & 1).Select [2:2].Insert [2:2] = "***" Range(sCOL & ":" & sCOL).Select With ActiveSheet .UsedRange lLastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row Set rng = Range(sCOL & 2, Cells(lLastRow, sCOL)) rng.AutoFilter Field:=1, Criteria1:=vSearch Set rngDelete = rng.SpecialCells(xlCellTypeVisible) rng.AutoFilter rngDelete.EntireRow.Delete .UsedRange End With End Sub
In this case a simple working formula can be used to see if each of the values in your range to be tested (column A of schedule) exist in column F of misc
B4 it would
This can be used manually or with code for an efficient delete as the formula by design returns an error if there is no match which we can efficiently delete with
VBA with either:
SpecialCells(the design piece*)
In xl2007 note that there is a limit of 8192 discrete areas that can be selected with
Sub ReCut() Dim ws1 As Worksheet Dim ws2 As Worksheet Dim rng1 As Range Set ws1 = Sheets("misc") Set ws2 = Sheets("schedule") With Application .ScreenUpdating = False .EnableEvents = False .DisplayAlerts = False End With Set rng1 = ws2.Range(ws2.[a4], ws2.Cells(Rows.Count, "A").End(xlUp)) ws2.Columns(2).Insert With rng1.Offset(0, 1) .FormulaR1C1 = "=MATCH(RC[-1],'" & ws1.Name & "'!C,0)" On Error Resume Next .Cells.SpecialCells(xlCellTypeFormulas, xlErrors).EntireRow.Delete On Error GoTo 0 End With ws2.Columns(2).Delete With Application .ScreenUpdating = True .EnableEvents = True .DisplayAlerts = True End With End Sub
Note: I don’t have enough “reputation” to add my comments thus posting as answer. Credit to hnk for wonderful answer (Long Answer). I have one edit as suggestion:
Once you split the long string and in case the last block is more than the set character then it is having “!” at the end which is throwing error for range method. Addition of IF statement and MID is ensuring that there is no such character.
To handle that, use:
For i = LBound(DelStr_Cut) + 1 To UBound(DelStr_Cut) If Right(DelStr_Cut(i), 1) = "!" Then DelStr_Cut(i) = Mid(DelStr_Cut(i), 1, Len(DelStr_Cut(i)) - 1) Set DeleteRng = Union(DeleteRng, ActiveSheet.Range(DelStr_Cut(i))) Else Set DeleteRng = Union(DeleteRng, ActiveSheet.Range(DelStr_Cut(i))) End If Next i