Delete multiple rows based on one cell value

[abarbee314]

Hi folks! Hope you're all doing well. I'll paste a sample data set down below, but here is the scenario for it:

Real/larger data set has nearly 2000 rows and 20+ columns. Many of the names appear in 2+ rows for some reason. SOME of the rows have a value in the second column that voids their need to be in the table. We want ALL entries for the names to be removed if *ANY* of them have the voiding value.

So, below I have decided that SNARKY is the "bad" word. My need here: If SNARKY appears as the status for someone, I want all rows for that person to selectable/deletable/deleted - whatever is the cleanest or most efficient.

Based on my sample sheet, the end result should only have rows for Sally, Mary, Carmen, and Kaitlin. Shawn and I are SNARKY, so all of our rows need to be removed since at least one of them has SNARKY as the status. Hope that makes sense. THANKS, in advance, as always

Name	Status	State
Aaron	Right-handed	Florida
Aaron	Snarky	Florida
Aaron	Brunette	Florida
Sally	Blonde	New York
Shawn	Brunette	Hawaii
Shawn	Snarky	Hawaii
Mary	Brunette	Kansas
Carmen	Right-handed	Missouri
Kaitlin	Blonde	Illinois
Kaitlin	Right-handed	Illinois

 

[tmskipper86]

Hello,
I use the below formula to first highlight "snarky" and then delete all rows with that color. In my example the range is Column A to Column G and "Snarky" is in Column E. Adjust to fit your needs. Hope it helps!




Sub Test_Snarky ()

'

' Test_Snarky Macro

'

Dim vLastRow As Long

vLastRow = Cells(Rows.Count, 2).End(xlUp).Row

'

Windows("TEST_FILE.xlsx").Activate

Sheets("SHEET1 ").Select

Selection.AutoFilter

Cells.Select

Cells.EntireColumn.AutoFit

Columns("E:E").Select

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _

Formula1:="=""Snarky"""

Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

With Selection.FormatConditions(1).Font

.Color = -16383844

.TintAndShade = 0

End With

With Selection.FormatConditions(1).Interior

.PatternColorIndex = xlAutomatic

.Color = 13551615

.TintAndShade = 0

End With

Selection.FormatConditions(1).StopIfTrue = False

Range("E1").Select

ActiveWorkbook.Worksheets("SHEET1").AutoFilter.Sort.SortFields.Clear

ActiveWorkbook.Worksheets("SHEET1 ").AutoFilter.Sort.SortFields.Add(Range( _

"E1:E" & vLastRow), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = _

RGB(255, 199, 206)

With ActiveWorkbook.Worksheets("SHEET1 ").AutoFilter.Sort

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

ActiveSheet.Range("$A$1:$G" & vLastRow).AutoFilter Field:=5, Criteria1:=RGB(255, _

199, 206), Operator:=xlFilterCellColor

Range(Range("$A$2:$G$2"), Range("$A$2:$G$2").End(xlDown)).Select

Selection.Delete Shift:=xlUp

Range("E1").Select

ActiveWorkbook.Save



End Sub

 

[igold]

How about this, assuming your data starts with the Header in Cell A1...

Sub DeleteSnarky()

    Dim arr, arr2, i As Long, r As Long, x As Long
    Dim wsS As Worksheet: Set wsS = ActiveSheet
   
    Application.ScreenUpdating = False
    arr = wsS.UsedRange
    r = 1
    ReDim arr2(1 To UBound(arr, 1))
    For i = 1 To UBound(arr)
        If arr(i, 2) = "Snarky" Then
            arr2(r) = arr(i, 1)
            r = r + 1
        End If
    Next
   
    ReDim Preserve arr2(1 To r - 1)
    For x = 1 To UBound(arr2)
        For i = 1 To UBound(arr)
            If arr(i, 1) = arr2(x) Then
                arr(i, 1) = ""
            End If
        Next
    Next

    With wsS.UsedRange
        wsS.Range("A1").Resize(.Rows.Count, .Columns.Count).Value = arr
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
   
End Sub

 

[kevin9999]

Another option

Option Explicit
Sub arabee314()
    Application.ScreenUpdating = False
    Dim ar, i As Long
    ar = Range("A1").CurrentRegion
    
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(ar)
            If ar(i, 2) = "Snarky" Then
                .Item(ar(i, 1)) = .Item(ar(i, 1))
            End If
        Next i
        ar = Array(.keys)
    End With
    
    With Range("A1").CurrentRegion
        .AutoFilter 1, Array(ar), 7
        .Offset(1).EntireRow.Delete
        .AutoFilter
    End With
    
    Application.ScreenUpdating = True
End Sub

 

[abarbee314]

Hello,
I use the below formula to first highlight "snarky" and then delete all rows with that color. In my example the range is Column A to Column G and "Snarky" is in Column E. Adjust to fit your needs. Hope it helps!




Sub Test_Snarky ()

'

' Test_Snarky Macro

'

Dim vLastRow As Long

vLastRow = Cells(Rows.Count, 2).End(xlUp).Row

'

Windows("TEST_FILE.xlsx").Activate

Sheets("SHEET1 ").Select

Selection.AutoFilter

Cells.Select

Cells.EntireColumn.AutoFit

Columns("E:E").Select

Selection.FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _

Formula1:="=""Snarky"""

Selection.FormatConditions(Selection.FormatConditions.Count).SetFirstPriority

With Selection.FormatConditions(1).Font

.Color = -16383844

.TintAndShade = 0

End With

With Selection.FormatConditions(1).Interior

.PatternColorIndex = xlAutomatic

.Color = 13551615

.TintAndShade = 0

End With

Selection.FormatConditions(1).StopIfTrue = False

Range("E1").Select

ActiveWorkbook.Worksheets("SHEET1").AutoFilter.Sort.SortFields.Clear

ActiveWorkbook.Worksheets("SHEET1 ").AutoFilter.Sort.SortFields.Add(Range( _

"E1:E" & vLastRow), xlSortOnCellColor, xlAscending, , xlSortNormal).SortOnValue.Color = _

RGB(255, 199, 206)

With ActiveWorkbook.Worksheets("SHEET1 ").AutoFilter.Sort

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

ActiveSheet.Range("$A$1:$G" & vLastRow).AutoFilter Field:=5, Criteria1:=RGB(255, _

199, 206), Operator:=xlFilterCellColor

Range(Range("$A$2:$G$2"), Range("$A$2:$G$2").End(xlDown)).Select

Selection.Delete Shift:=xlUp

Range("E1").Select

ActiveWorkbook.Save



End Sub

First off, thank you for being so quick to reply. I ended up with a Syntax Error when tried to run this.

 

[abarbee314]

How about this, assuming your data starts with the Header in Cell A1...

Sub DeleteSnarky()

    Dim arr, arr2, i As Long, r As Long, x As Long
    Dim wsS As Worksheet: Set wsS = ActiveSheet
  
    Application.ScreenUpdating = False
    arr = wsS.UsedRange
    r = 1
    ReDim arr2(1 To UBound(arr, 1))
    For i = 1 To UBound(arr)
        If arr(i, 2) = "Snarky" Then
            arr2(r) = arr(i, 1)
            r = r + 1
        End If
    Next
  
    ReDim Preserve arr2(1 To r - 1)
    For x = 1 To UBound(arr2)
        For i = 1 To UBound(arr)
            If arr(i, 1) = arr2(x) Then
                arr(i, 1) = ""
            End If
        Next
    Next

    With wsS.UsedRange
        wsS.Range("A1").Resize(.Rows.Count, .Columns.Count).Value = arr
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End With
    Application.ScreenUpdating = True
  
End Sub

Thanks SO MUCH for being so quick to reply! This was the first of two that worked with my sample data right away - so you win.
Any suggestions for how I add add'l layers to my filtering? If I wanted to also screen for 1 or 2 more words/phrases in addition to SNARKY, how can we edit the code?

You guys are way more experienced with VBA than I am; I'm solid with regular excel stuff. But I didn't want to make an assumption on how to add others phrases to this filtering and deleting.

Thanks again!

 

[abarbee314]

Another option

Option Explicit
Sub arabee314()
    Application.ScreenUpdating = False
    Dim ar, i As Long
    ar = Range("A1").CurrentRegion
   
    With CreateObject("Scripting.Dictionary")
        For i = 1 To UBound(ar)
            If ar(i, 2) = "Snarky" Then
                .Item(ar(i, 1)) = .Item(ar(i, 1))
            End If
        Next i
        ar = Array(.keys)
    End With
   
    With Range("A1").CurrentRegion
        .AutoFilter 1, Array(ar), 7
        .Offset(1).EntireRow.Delete
        .AutoFilter
    End With
   
    Application.ScreenUpdating = True
End Sub

Thanks SO MUCH for being so quick to reply! This was another one that worked with my sample data right away. I love how your script didn't remove my Table formatting - not that it was critical. But, very handy.

Any suggestions for how I add add'l layers to my filtering? If I wanted to also screen for 1 or 2 more words/phrases in addition to SNARKY, how can we edit the code?

You guys are way more experienced with VBA than I am; I'm solid with regular excel stuff. But I didn't want to make an assumption on how to add others phrases to this filtering and deleting.

Thank you again!

 

[igold]

You're welcome, I am sure we were all happy to help. Thanks for the feedback.
As far as adding additional criteria, it depends how familiar you are with working with Arrays. In my code this section

For i = 1 To UBound(arr)
        If arr(i, 2) = "Snarky" Then
            arr2(r) = arr(i, 1)
            r = r + 1
        End If
    Next

is isolating any name that has "Snarky" as the second element of (arr,2) and putting that name into the array arr2.
Then the next section is taking that name and replacing it with a blank in the postion of arr(i,1).

 ReDim Preserve arr2(1 To r - 1)
    For x = 1 To UBound(arr2)
        For i = 1 To UBound(arr)
            If arr(i, 1) = arr2(x) Then
                arr(i, 1) = ""
            End If
        Next
    Next

Finally the code is putting all the data back on your sheet but instead of names that were in Column A there are now blanks. Then we tell Excel to delete any row that has a blank in Column A.

With wsS.UsedRange
        wsS.Range("A1").Resize(.Rows.Count, .Columns.Count).Value = arr
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End With
    Application.ScreenUpdating = True

I hope that helps some. If not just repost with your additional criteria and I am sure you will get the help you need.

 

[abarbee314]

You're welcome, I am sure we were all happy to help. Thanks for the feedback.
As far as adding additional criteria, it depends how familiar you are with working with Arrays. In my code this section

For i = 1 To UBound(arr)
        If arr(i, 2) = "Snarky" Then
            arr2(r) = arr(i, 1)
            r = r + 1
        End If
    Next

is isolating any name that has "Snarky" as the second element of (arr,2) and putting that name into the array arr2.
Then the next section is taking that name and replacing it with a blank in the postion of arr(i,1).

 ReDim Preserve arr2(1 To r - 1)
    For x = 1 To UBound(arr2)
        For i = 1 To UBound(arr)
            If arr(i, 1) = arr2(x) Then
                arr(i, 1) = ""
            End If
        Next
    Next

Finally the code is putting all the data back on your sheet but instead of names that were in Column A there are now blanks. Then we tell Excel to delete any row that has a blank in Column A.

With wsS.UsedRange
        wsS.Range("A1").Resize(.Rows.Count, .Columns.Count).Value = arr
        .SpecialCells(xlCellTypeBlanks).EntireRow.Delete
    End With
    Application.ScreenUpdating = True

I hope that helps some. If not just repost with your additional criteria and I am sure you will get the help you need.

Being brutally honest - my VBA skills = opening the interface and running it. I attempted to copy/edit/paste a new filter within your code but likely put something in the wrong order. I tried adding in "BLONDE" as a second filter but it sort of broke the SNARKY filter.

So, what would your code look like with a filter for SNARKY and one for BLONDE, both operating in the same manner - deleting all owners? Using my original table, that should leave only Mary and Carmen. Just trying to understand where the order of operations is, so that I can re-build this with the real phrases/words for my customer at work. She's got at least two phrases we need to filter on, but if she has more than two we have to filter out, I imagine I can edit your script for 3+ phrases on my own once I see how you transitioned from just "SNARKY" to "SNARKY or BLONDE". Thanks again

 

[igold]

Being brutally honest - my VBA skills = opening the interface and running it.

We all started in the same place!

Are SNARKY and BLONDE both in column B or are they in different columns. A small sample of your data is always a good thing .