Databases
StackOverflow2013
Postsdbo
POfaster deletion of rows
Body
 

Note that there are some explanatory texts on larger screens.

plurals
  1. POfaster deletion of rows
    text
    copied!<p>the code below allows me to delete rows if a cells contains certain values. now for some reason it takes me a lot of time(30 mins and counting).</p> <pre><code>' to delete data not meeting criteria Worksheets("Dashboard").Activate n1 = Range("n1") n2 = Range("n2") Worksheets("Temp Calc").Activate lastrow = Cells(Rows.Count, 1).End(xlUp).Row For z = lastrow To 2 Step -1 If Cells(z, 6).Value = "CNF" Or Cells(z, 4).Value &lt;= n1 Or Cells(z, 3).Value &gt;= n2 Then Rows(z).Delete End If Next z </code></pre> <p>a google search and some talk with forum member sam provided me with two options </p> <ol> <li>to use filter.(i do want to use this).</li> <li><p>using arrays to store the entire worksheet and then copy data that only matches my criteria.He was kind enough to help me come up with the following code.But i am not familiar with working on data in an array.</p> <pre><code>lastrow = Cells(Rows.Count, 1).End(xlUp).Row lastCol = Cells(1, Column.Count).End(xlRight).Row arr1 = Range("A1:Z" &amp; lastrow) ReDim arr2(1 To UBound(arr1, 1), 1 To UBound(arr1, 2)) j = j + 1 For i = 1 To UBound(arr1, 1) If arr1(i, 6) &lt;&gt; "CNF" And arr1(i, 4) &gt; n1 And arr1(i, 3) &lt; n2 Then For k = 1 To lastCol arr2(j, k) = arr1(i, k) Next k j = j + 1 End If Next i Range(the original bounds) = arr2 </code></pre></li> </ol> <p>my question is is there a faster way of deleting rows in an array other than the ones mentioned above? Or is array or filter the best options i've got.I am open to suggestions.</p> <p>Update my new code looks like this. it does not filter the date rangeeven if they are hardcoded can anybody tell me what i am doing wrong ?</p> <pre><code>Option Explicit Sub awesome() Dim Master As Workbook Dim fd As FileDialog Dim filechosen As Integer Dim i As Integer Dim lastrow, x As Long Dim z As Long Application.ScreenUpdating = False Dim sngStartTime As Single Dim sngTotalTime As Single Dim ws As Worksheet Dim FltrRng As Range Dim lRow As Long Dim N1 As Date, N2 As Date sngStartTime = Timer Sheets("Dashboard").Select N1 = Range("n1").Value N2 = Range("n2").Value Sheets("Temp Calc").Select 'Clear existing sheet data except headers 'Sheets("Temp Calc").Select 'Rows(1).Offset(1, 0).Resize(Rows.Count - 1).ClearContents 'The folder containing the files to be recap'd Set fd = Application.FileDialog(msoFileDialogFilePicker) fd.InitialFileName = "G:\Work\" '&lt;----- Change this to where the files are stored. fd.InitialView = msoFileDialogViewList 'allow multiple file selection fd.AllowMultiSelect = True fd.Filters.Add "Excel Files", "*.xls*" filechosen = fd.Show 'Create a workbook for the recap report Set Master = ThisWorkbook If filechosen = -1 Then 'open each of the files chosen For i = 1 To fd.SelectedItems.Count Workbooks.Open fd.SelectedItems(i) With ActiveWorkbook.Worksheets(1) Range("O2", Range("O" &amp; Cells(Rows.Count, "O").End(xlUp).Row)).Copy Master.Worksheets(2).Range("A" &amp; Rows.Count).End(xlUp).Offset(1, 0) Range("p2", Range("P" &amp; Cells(Rows.Count, "P").End(xlUp).Row)).Copy Master.Worksheets(2).Range("B" &amp; Rows.Count).End(xlUp).Offset(1, 0) Range("Q2", Range("Q" &amp; Cells(Rows.Count, "Q").End(xlUp).Row)).Copy Master.Worksheets(2).Range("C" &amp; Rows.Count).End(xlUp).Offset(1, 0) Range("R2", Range("R" &amp; Cells(Rows.Count, "R").End(xlUp).Row)).Copy Master.Worksheets(2).Range("D" &amp; Rows.Count).End(xlUp).Offset(1, 0) Range("A2", Range("A" &amp; Cells(Rows.Count, "A").End(xlUp).Row)).Copy Master.Worksheets(2).Range("E" &amp; Rows.Count).End(xlUp).Offset(1, 0) Range("AC2", Range("AC" &amp; Cells(Rows.Count, "AC").End(xlUp).Row)).Copy Master.Worksheets(2).Range("F" &amp; Rows.Count).End(xlUp).Offset(1, 0) End With ' Sheets(1).Range("D4", Sheets(1).Range("D" &amp; Sheets(1).Cells(Rows.Count, "D").End(xlUp).Row)).Copy Sheets(2).Range("B" &amp; Sheets(2).Rows.Count).End(xlUp).Offset(1, 0) ActiveWorkbook.Close (False) Next i End If Set ws = ThisWorkbook.Worksheets("Temp Calc") '~~&gt; Start Date and End Date N1 = #5/1/2012#: N2 = #7/1/2012# With ws '~~&gt; Remove any filters .AutoFilterMode = False '~~&gt; Get the last row lRow = .Range("A" &amp; .Rows.Count).End(xlUp).Row '~~&gt; Identify your data range Set FltrRng = .Range("A1:F" &amp; lRow) '~~&gt; Filter the data as per your criteria With FltrRng '~~&gt; First filter on blanks .AutoFilter Field:=6, Criteria1:="=" Application.ScreenUpdating = False Application.Calculation = xlCalculationManual '~~&gt; Delete the filtered blank rows .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete ws.ShowAllData '~~&gt; Next filter on Start Date .AutoFilter Field:=3, Criteria1:="&lt;" &amp; N1, Operator:=xlAnd '~~&gt; Finally filter on End Date .AutoFilter Field:=4, Criteria1:="&gt;" &amp; N2, Operator:=xlAnd '~~&gt; Filter on col 6 for CNF '.AutoFilter Field:=6, Criteria1:="CNF" '~~&gt; Delete the filtered rows .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete End With Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic '~~&gt; Remove any filters .AutoFilterMode = False End With sngTotalTime = Timer - sngStartTime MsgBox "Time taken: " &amp; (sngTotalTime \ 60) &amp; " minutes, " &amp; (sngTotalTime Mod 60) &amp; " seconds" Application.Goto (ActiveWorkbook.Sheets("Dashboard").Range("A4")) Sheets("Dashboard").Select Application.ScreenUpdating = True End Sub </code></pre>
 

Querying!

 
Guidance
An individual column

Larger individual text columns get their own page to allow for proper reading.

SQuiL has stopped working due to an internal error.

If you are curious you may find further information in the browser console, which is accessible through the devtools (F12).

Reload