title: Excel VBA Performance - 1 million rows - Delete rows containing a value, in less than 1 min
body: <p>I am trying to find a way to filter large data and remove rows in a worksheet, in less than one minute</p>
  
  <p>The goal:</p>
  
  <ul>
  <li>Find all records containing specific text in column 1, and delete the entire row</li>
  <li>Keep all cell formatting (colors, font, borders, column widths) and formulas as they are</li>
  </ul>
  
  <p>.</p>
  
  <p>Test Data:</p>
  
  <p><img src="https://i.stack.imgur.com/6XQDp.png" alt="Test data">:</p>
  
  <p>.</p>
  
  <p>How the code works:</p>
  
  <ol>
  <li>It starts by turning all Excel features Off</li>
  <li><p>If the workbook is not empty and the text value to be removed exists in column 1</p>
  
  <ul>
  <li>Copies the used range of column 1 to an array</li>
  <li>Iterates over every value in array backwards</li>
  <li><p>When it finds a match:</p>
  
  <ul>
  <li>Appends the cell address to a tmp string in the format <code>"A11,A275,A3900,..."</code></li>
  <li>If the tmp variable length is close to 255 characters</li>
  <li>Deletes rows using <code>.Range("A11,A275,A3900,...").EntireRow.Delete Shift:=xlUp</code></li>
  <li>Resets tmp to empty and moves on to the next set of rows</li>
  </ul></li>
  </ul></li>
  <li>At the end, it turns all Excel features back On</li>
  </ol>
  
  <p>.</p>
  
  <p><strong>The main issue is the Delete operation</strong>, and total duration time should be under one minute. Any code-based solution is acceptable as long as it performs under 1 minute.</p>
  
  <p>This narrows the scope to very few acceptable answers. The answers already provided are also very short and easy to implement. <a href="https://stackoverflow.com/a/30959316/4914662">One</a> performs the operation in about 30 seconds, so there is at least one answer that provides an acceptable solution, and other may find it useful as well</p>
  
  <p>.</p>
  
  <p>My main initial function:</p>
  
  <pre><code>Sub DeleteRowsWithValuesStrings()
      Const MAX_SZ As Byte = 240
  
      Dim i As Long, j As Long, t As Double, ws As Worksheet
      Dim memArr As Variant, max As Long, tmp As String
  
      Set ws = Worksheets(1)
      max = GetMaxCell(ws.UsedRange).Row
      FastWB True:    t = Timer
  
      With ws
          If max &gt; 1 Then
              If IndexOfValInRowOrCol("Test String", , ws.UsedRange) &gt; 0 Then
                  memArr = .Range(.Cells(1, 1), .Cells(max, 1)).Value2
                  For i = max To 1 Step -1
  
                      If memArr(i, 1) = "Test String" Then
                          tmp = tmp &amp; "A" &amp; i &amp; ","
                          If Len(tmp) &gt; MAX_SZ Then
                             .Range(Left(tmp, Len(tmp) - 1)).EntireRow.Delete Shift:=xlUp
                             tmp = vbNullString
  
                          End If
                      End If
  
                  Next
                  If Len(tmp) &gt; 0 Then
                      .Range(Left(tmp, Len(tmp) - 1)).EntireRow.Delete Shift:=xlUp
                  End If
                  .Calculate
              End If
          End If
      End With
      FastWB False:   InputBox "Duration: ", "Duration", Timer - t
  End Sub
  </code></pre>
  
  <hr>
  
  <p>Helper functions (turn Excel features off and on):</p>
  
  <pre><code>Public Sub FastWB(Optional ByVal opt As Boolean = True)
      With Application
          .Calculation = IIf(opt, xlCalculationManual, xlCalculationAutomatic)
          .DisplayAlerts = Not opt
          .DisplayStatusBar = Not opt
          .EnableAnimations = Not opt
          .EnableEvents = Not opt
          .ScreenUpdating = Not opt
      End With
      FastWS , opt
  End Sub
  
  Public Sub FastWS(Optional ByVal ws As Worksheet = Nothing, _
                    Optional ByVal opt As Boolean = True)
      If ws Is Nothing Then
          For Each ws In Application.ActiveWorkbook.Sheets
              EnableWS ws, opt
          Next
      Else
          EnableWS ws, opt
      End If
  End Sub
  
  Private Sub EnableWS(ByVal ws As Worksheet, ByVal opt As Boolean)
      With ws
          .DisplayPageBreaks = False
          .EnableCalculation = Not opt
          .EnableFormatConditionsCalculation = Not opt
          .EnablePivotTable = Not opt
      End With
  End Sub
  </code></pre>
  
  <hr>
  
  <p>Finds last cell with data (thanks @ZygD - now I tested it in several scenarios):</p>
  
  <pre><code>Public Function GetMaxCell(Optional ByRef rng As Range = Nothing) As Range
  
      'Returns the last cell containing a value, or A1 if Worksheet is empty
  
      Const NONEMPTY As String = "*"
      Dim lRow As Range, lCol As Range
  
      If rng Is Nothing Then Set rng = Application.ActiveWorkbook.ActiveSheet.UsedRange
      If WorksheetFunction.CountA(rng) = 0 Then
          Set GetMaxCell = rng.Parent.Cells(1, 1)
      Else
          With rng
              Set lRow = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _
                                          After:=.Cells(1, 1), _
                                          SearchDirection:=xlPrevious, _
                                          SearchOrder:=xlByRows)
              If Not lRow Is Nothing Then
                  Set lCol = .Cells.Find(What:=NONEMPTY, LookIn:=xlFormulas, _
                                              After:=.Cells(1, 1), _
                                              SearchDirection:=xlPrevious, _
                                              SearchOrder:=xlByColumns)
  
                  Set GetMaxCell = .Parent.Cells(lRow.Row, lCol.Column)
              End If
          End With
      End If
  End Function
  </code></pre>
  
  <hr>
  
  <p>Returns the index of a match in the array, or 0 if a match is not found:</p>
  
  <pre><code>Public Function IndexOfValInRowOrCol( _
                                      ByVal searchVal As String, _
                                      Optional ByRef ws As Worksheet = Nothing, _
                                      Optional ByRef rng As Range = Nothing, _
                                      Optional ByRef vertical As Boolean = True, _
                                      Optional ByRef rowOrColNum As Long = 1 _
                                      ) As Long
  
      'Returns position in Row or Column, or 0 if no matches found
  
      Dim usedRng As Range, result As Variant, searchRow As Long, searchCol As Long
  
      result = CVErr(9999) '- generate custom error
  
      Set usedRng = GetUsedRng(ws, rng)
      If Not usedRng Is Nothing Then
          If rowOrColNum &lt; 1 Then rowOrColNum = 1
          With Application
              If vertical Then
                  result = .Match(searchVal, rng.Columns(rowOrColNum), 0)
              Else
                  result = .Match(searchVal, rng.Rows(rowOrColNum), 0)
              End If
          End With
      End If
      If IsError(result) Then IndexOfValInRowOrCol = 0 Else IndexOfValInRowOrCol = result
  End Function
  </code></pre>
  
  <p>.</p>
  
  <p><strong>Update:</strong></p>
  
  <p>Tested 6 solutions (3 tests each): <strong><a href="https://stackoverflow.com/a/33192437/4914662">Excel Hero's solution is the fastest</a></strong> so far (removes formulas)</p>
  
  <p>.</p>
  
  <p>Here are the results, fastest to the slowest:</p>
  
  <p>.</p>
  
  <p>Test 1. Total of 100,000 records, 10,000 to be deleted:</p>
  
  <pre><code>1. ExcelHero()                    - 1.5 seconds
  
  2. DeleteRowsWithValuesNewSheet() - 2.4 seconds
  
  3. DeleteRowsWithValuesStrings()  - 2.45 minutes
  4. DeleteRowsWithValuesArray()    - 2.45 minutes
  5. QuickAndEasy()                 - 3.25 minutes
  6. DeleteRowsWithValuesUnion()    - Stopped after 5 minutes
  </code></pre>
  
  <p>.</p>
  
  <p>Test 2. Total of 1 million records, 100,000 to be deleted:</p>
  
  <pre><code>1. ExcelHero()                    - 16 seconds (average)
  
  2. DeleteRowsWithValuesNewSheet() - 33 seconds (average)
  
  3. DeleteRowsWithValuesStrings()  - 4 hrs 38 min (16701.375 sec)
  4. DeleteRowsWithValuesArray()    - 4 hrs 37 min (16626.3051757813 sec)
  5. QuickAndEasy()                 - 5 hrs 40 min (20434.2104492188 sec)
  6. DeleteRowsWithValuesUnion()    - N/A
  </code></pre>
  
  <p>.</p>
  
  <p>Notes:</p>
  
  <ol>
  <li>ExcelHero method: easy to implement, reliable, extremely fast, but removes formulas</li>
  <li>NewSheet method: easy to implement, reliable, and meets the target</li>
  <li>Strings method: more effort to implement, reliable, but doesn't meet requirement</li>
  <li>Array method: similar to Strings, but ReDims an array (faster version of Union)</li>
  <li>QuickAndEasy: easy to implement (short, reliable and elegant), but doesn't meet requirement</li>
  <li>Range Union: implementation complexity similar to 2 and 3, but too slow</li>
  </ol>
  
  <p>I also made the test data more realistic by introducing unusual values:</p>
  
  <ul>
  <li>empty cells, ranges, rows, and columns</li>
  <li>special characters, like =[`~!@#$%^&amp;*()_-+{}[]\|;:'",.&lt;>/?, separate and multiple combinations</li>
  <li>blank spaces, tabs, empty formulas, border, font, and other cell formatting</li>
  <li>large and small numbers with decimals (=12.9999999999999 + 0.00000000000000001)</li>
  <li>hyperlinks, conditional formatting rules</li>
  <li>empty formatting inside and outside data ranges</li>
  <li>anything else that might cause data issues</li>
  </ul>