Delete rows based on list of different words/arguments

[BexcelB]

Hi,

I have a list of 25.000 products and some rows has to be deleted since they are not interestning.

Is is possible to create VBA code that goes trough the complete sheet and delete rows based on a list of different words/different arguments.
Product name often consist two words but the VBA code just have look on only one word.

Hope it makes sense.

Best regards
BexcelB

 

[shinigamilight]

yes it is possible make sure to provide some sample data, maybe with like operator or instr or if it's more advanced maybe with Regex.

 

[BexcelB]

yes it is possible make sure to provide some sample data, maybe with like operator or instr or if it's more advanced maybe with Regex.

F.ex. rows that contains Aronia and Arrangement should be deleted. But there can be many different words.

 

[shinigamilight]

Sub Row_Deleter()
        '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> _
        ALWAYS TEST YOUR CODE ON A SAMPLE OF DATA TO FIND BUGS
        Dim lr As Long
        lr = Range("A" & Rows.Count).End(xlUp).Row
        Dim k As Long
        Dim V, S
        Dim store As Long
        V = Array("Louis", "Becky") ' add the words you want to delete and remember that this is a CASE SENSITIVE search
        
        For k = lr To 2 Step -1
                For Each S In V
                  If InStr(1, Range("A" & k), S) > 0 Then
                    store = store + 1
                  End If
                Next S
                        If store >= 1 Then
                            Range("A" & k).EntireRow.Delete
                        End If
                    store = 0
        Next k
        
End Sub

 

[BexcelB]

Sub Row_Deleter()
        '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> _
        ALWAYS TEST YOUR CODE ON A SAMPLE OF DATA TO FIND BUGS
        Dim lr As Long
        lr = Range("A" & Rows.Count).End(xlUp).Row
        Dim k As Long
        Dim V, S
        Dim store As Long
        V = Array("Louis", "Becky") ' add the words you want to delete and remember that this is a CASE SENSITIVE search
      
        For k = lr To 2 Step -1
                For Each S In V
                  If InStr(1, Range("A" & k), S) > 0 Then
                    store = store + 1
                  End If
                Next S
                        If store >= 1 Then
                            Range("A" & k).EntireRow.Delete
                        End If
                    store = 0
        Next k
      
End Sub

Thanks - this work absolutely perfect. Possible to search and delete words in more than one column? F.ex. from column A to J.

 

[shinigamilight]

Try this

Sub Row_Deleter_2()
        '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> _
        ALWAYS TEST YOUR CODE ON A SAMPLE OF DATA TO FIND BUGS
        Dim lr As Long
        lr = Range("A" & Rows.Count).End(xlUp).Row
        Dim k, i As Long
        Dim V, S
        Dim store As Long
        V = Array("Louis", "Becky") ' add the words you want to delete and remember that this is a CASE SENSITIVE search
        
        For i = 1 To 10 '10 is the column J change it accordingly
                    For k = lr To 2 Step -1
                            For Each S In V
                              If InStr(1, Cells(k, i), S) > 0 Then
                                store = store + 1
                              End If
                            Next S
                                    If store >= 1 Then
                                        Cells(k, i).EntireRow.Delete
                                    End If
                                store = 0
                    Next k
            lr = Range("A" & Rows.Count).End(xlUp).Row
        Next i
End Sub

 

[BexcelB]

Try this

Sub Row_Deleter_2()
        '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> _
        ALWAYS TEST YOUR CODE ON A SAMPLE OF DATA TO FIND BUGS
        Dim lr As Long
        lr = Range("A" & Rows.Count).End(xlUp).Row
        Dim k, i As Long
        Dim V, S
        Dim store As Long
        V = Array("Louis", "Becky") ' add the words you want to delete and remember that this is a CASE SENSITIVE search
       
        For i = 1 To 10 '10 is the column J change it accordingly
                    For k = lr To 2 Step -1
                            For Each S In V
                              If InStr(1, Cells(k, i), S) > 0 Then
                                store = store + 1
                              End If
                            Next S
                                    If store >= 1 Then
                                        Cells(k, i).EntireRow.Delete
                                    End If
                                store = 0
                    Next k
            lr = Range("A" & Rows.Count).End(xlUp).Row
        Next i
End Sub

Thx - works excellent.

 

[BexcelB]

How can I add more lines when all fields are used in this string: V = Array("Louis", "Becky") ... ... ...
I tried to add another string below to the first one V = Array("Louis2", "Becky2") - but that is not working. Code is not crashing either but it only runs trough the first one.

 

[BexcelB]

.

 

[BexcelB]

Try this

Sub Row_Deleter_2()
        '>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> _
        ALWAYS TEST YOUR CODE ON A SAMPLE OF DATA TO FIND BUGS
        Dim lr As Long
        lr = Range("A" & Rows.Count).End(xlUp).Row
        Dim k, i As Long
        Dim V, S
        Dim store As Long
        V = Array("Louis", "Becky") ' add the words you want to delete and remember that this is a CASE SENSITIVE search
       
        For i = 1 To 10 '10 is the column J change it accordingly
                    For k = lr To 2 Step -1
                            For Each S In V
                              If InStr(1, Cells(k, i), S) > 0 Then
                                store = store + 1
                              End If
                            Next S
                                    If store >= 1 Then
                                        Cells(k, i).EntireRow.Delete
                                    End If
                                store = 0
                    Next k
            lr = Range("A" & Rows.Count).End(xlUp).Row
        Next i
End Sub

Can add another line V = Array("Louis", "Becky") etc. below to exisiting one?