Delete cells that don't meet certain criteria

[vrobinson0304]

Hello,

I'm trying to write a macro that will delete all rows that don't have certain values in column A. The values are determined in cells O1, O2, and O3. I got the code below to work for values in O1 and O2, however it does not allow me to set a third criteria for O3. I believe I may have to do a an array. Can someone please help! Thank you.

[COLOR=#4f6228]Sub DelRows()<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:office:office" /><o:p></o:p>[/COLOR]
[COLOR=#4f6228]    Application.ScreenUpdating = False<o:p></o:p>[/COLOR]
[COLOR=#4f6228]    ActiveSheet.AutoFilterMode = False<o:p></o:p>[/COLOR]
[COLOR=#4f6228]    On Error Resume Next<o:p></o:p>[/COLOR]
[COLOR=#4f6228]        With Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)<o:p></o:p>[/COLOR]
[COLOR=#4f6228]        .AutoFilter Field:=1, Criteria1:="<>" & Range("O1").Value, Criteria2:="<>" & Range("O2").Value<o:p></o:p>[/COLOR]
[COLOR=#4f6228]                .Offset(4).SpecialCells(xlCellTypeVisible).EntireRow.Delete<o:p></o:p>[/COLOR]
[COLOR=#4f6228]        .AutoFilter<o:p></o:p>[/COLOR]
[COLOR=#4f6228]    End With<o:p></o:p>[/COLOR]
[COLOR=#4f6228]    Application.ScreenUpdating = True<o:p></o:p>[/COLOR]
[COLOR=#4f6228]End Sub[/COLOR]

 

[Rick Rothstein]

This modification to my previously posted code will first delete the rows you want deleted, then sort the data in the same order the words in the word list are listed in...

Sub DeleteAllExceptForO1toO3()
  Dim UnusedColumn As Long, LastRow As Long, ListColumn As Long, ListCount As Long
  Const StartRow As Long = 4
  Const WordListColumn As String = "O"
  Const WordListCount As Long = 3
  ListColumn = Columns(WordListColumn).Column
  UnusedColumn = Cells.Find(What:="*", SearchOrder:=xlByColumns, _
                 SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column + 1
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Application.ScreenUpdating = False
  With Cells(StartRow, UnusedColumn).Resize(LastRow - StartRow + 1)
    .FormulaR1C1 = "=IF(COUNTIF(R1C" & ListColumn & ":R" & WordListCount & "C" & ListColumn & ",RC[-" & (UnusedColumn - 1) & "]),MATCH(RC[-" & (UnusedColumn - 1) & "],R1C" & ListColumn & ":R" & WordListCount & "C" & ListColumn & ",0),"""")"
    .Value = .Value
    .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
  End With
  Cells(StartRow, "A").Resize(Cells(Rows.Count, "A").End(xlUp).Row - StartRow + 1, UnusedColumn).Sort Key1:=Cells(StartRow, UnusedColumn), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
  Columns(UnusedColumn).Clear
  Application.ScreenUpdating = True
End Sub

 

[vrobinson0304]

you are a life saver .

 

[Peter_SSs]

Definitely not a big issue with only a couple of thousand rows but in looking at Rick's code I did have these thoughts.

- Deleting a lot of disjoint rows can sometimes be bit slow compared to deleting a single continuous block of rows, so perhaps sort first, then delete. This would also avoid any potential problem (especially with a v. large data set and an older Excel version) with a Specialcells areas limit.

- A direct MATCH formula could be used (& delete errors) instead of including the IF() to create the blank cells to delete.

So, my tweak of the code would be as follows. (Also removed ListCount declaration as it wasn't used.)

<font face=Courier New><br><SPAN style="color:#00007F">Sub</SPAN> DeleteAllExceptForO1toO3_Tweak()<br>    <SPAN style="color:#00007F">Dim</SPAN> UnusedColumn <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN>, LastRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN><br>    <SPAN style="color:#00007F">Const</SPAN> StartRow <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN> = 4<br>    <SPAN style="color:#00007F">Const</SPAN> WordListColumn <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = "O"<br>    <SPAN style="color:#00007F">Const</SPAN> WordListCount <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">Long</SPAN> = 3<br>    <SPAN style="color:#00007F">Const</SPAN> FormulaBase <SPAN style="color:#00007F">As</SPAN> <SPAN style="color:#00007F">String</SPAN> = "=MATCH(A@,#,0)"<br>    UnusedColumn = Cells.Find(What:="*", SearchOrder:=xlByColumns, _<br>                   SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column + 1<br>    LastRow = Cells(Rows.Count, "A").End(xlUp).Row<br>    Application.ScreenUpdating = <SPAN style="color:#00007F">False</SPAN><br>    <SPAN style="color:#00007F">With</SPAN> Cells(StartRow, UnusedColumn).Resize(LastRow - StartRow + 1)<br>        .Formula = Replace(Replace(FormulaBase, "@", StartRow), "#", _<br>            Cells(1, WordListColumn).Resize(WordListCount).Address)<br>        .Value = .Value<br>        .Offset(, 1 - UnusedColumn).Resize(, UnusedColumn).Sort _<br>            Key1:=Cells(StartRow, UnusedColumn), Order1:=xlAscending, _<br>            Header:=xlGuess, OrderCustom:=1, MatchCase:=False, _<br>            Orientation:=xlTopToBottom, DataOption1:=xlSortNormal<br>        .SpecialCells(xlCellTypeConstants, xlErrors).EntireRow.Delete<br>        .ClearContents<br>    <SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">With</SPAN><br>    Application.ScreenUpdating = <SPAN style="color:#00007F">True</SPAN><br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

 

[Rick Rothstein]

- Deleting a lot of disjoint rows can sometimes be bit slow compared to deleting a single continuous block of rows, so perhaps sort first, then delete. This would also avoid any potential problem (especially with a v. large data set and an older Excel version) with a Specialcells areas limit.

- A direct MATCH formula could be used (& delete errors) instead of including the IF() to create the blank cells to delete.

Sort first, then delete... well, duh, but of course. **** I am mad at myself for having missed that! However, I wouldn't change from the IF() formula that I used originally... with it, once the sort has taken place, all the blanks in the UnusedColumn will follow the numbers used to perform the sort, so we can easily delete those rows without having to use SpecialCells at all...

Sub DeleteAllExceptForO1toO3()
  Dim UnusedColumn As Long, LastRow As Long, ListColumn As Long, ListCount As Long
  Const StartRow As Long = 4
  Const WordListColumn As String = "O"
  Const WordListCount As Long = 3
  ListColumn = Columns(WordListColumn).Column
  UnusedColumn = Cells.Find(What:="*", SearchOrder:=xlByColumns, _
                 SearchDirection:=xlPrevious, LookIn:=xlFormulas).Column + 1
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Application.ScreenUpdating = False
  With Cells(StartRow, UnusedColumn).Resize(LastRow - StartRow + 1)
    .FormulaR1C1 = "=IF(COUNTIF(R1C" & ListColumn & ":R" & WordListCount & "C" & ListColumn & ",RC[-" & (UnusedColumn - 1) & "]),MATCH(RC[-" & (UnusedColumn - 1) & "],R1C" & ListColumn & ":R" & WordListCount & "C" & ListColumn & ",0),"""")"
    .Value = .Value
  End With
  Cells(StartRow, "A").Resize(Cells(Rows.Count, "A").End(xlUp).Row - StartRow + 1, UnusedColumn).Sort Key1:=Cells(StartRow, UnusedColumn), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
  Range(Cells(Rows.Count, UnusedColumn).End(xlUp).Offset(1), Cells(LastRow, UnusedColumn)).EntireRow.Delete
  Columns(UnusedColumn).Clear
  Application.ScreenUpdating = True
End Sub

 

[Peter_SSs]

****, I'm annoyed!

**** I am mad at myself ...

Hey Rick, go easy on yourself, people will begin to worry about you!!

However, I wouldn't change from the IF() formula that I used originally... with it, once the sort has taken place, all the blanks in the UnusedColumn will follow the numbers used to perform the sort, so we can easily delete those rows without having to use SpecialCells at all...

You are ceratinly right that it could just as well be done that way. Just as a matter of interest, is there a reason it is better to (use the more detailed formula and) avoid the SpecialCells given that, after the sort, the SpecialCells(errors) will just consist of a single area? Testing up to about 30,000 rows there was not much difference in run-time between the two codes.

 

[vrobinson0304]

Thanks to both of you. That was much faster.