Macro to remove all rows except those containing certain text

Question

I'm trying to write a Macro which will delete every row, apart from those which contain some specific text.

I need to have the following criteria:

Never delete the first 2 rows
Exclude the rows where the word "Somme" can be found in column C or D.

Note, the word Somme if part of a string in column C or D. An example of the text found would be something like:

Somme alpha/000284727819293

What I have so far is code which deletes rows with Somme in it, however i need the opposite:

Sub CleanUp()
    Dim c As Range
    Dim SrchRng

    Set SrchRng = ActiveSheet.Range("D3", ActiveSheet.Range("D65536").End(xlUp))
    Do
        Set c = SrchRng.Find("Somme", LookIn:=xlValues)
        If Not c Is Nothing Then c.EntireRow.Delete
    Loop While Not c Is Nothing
End Sub

Why not use Autofilter? http://stackoverflow.com/questions/11631363/how-to-copy-a-line-in-excel-using-a-specific-word-and-pasting-to-another-excel-s — Siddharth Rout, Oct 25 '13 at 13:05
I need to remove the content from the page rather than filter it out due to some other stuff im doing — Xeo, Oct 25 '13 at 13:07
Give it a try. I already have the code ready and assure you that Autofilter works :) — Siddharth Rout, Oct 25 '13 at 13:18

Gary's Student · Answer 1 · 2013-10-25T13:43:11.020

Give this a shot:

Sub SaveSomeRows()
    Dim N As Long, L As Long, r As Range
    Dim s As String, v As String
    Set r = ActiveSheet.Range("D3", ActiveSheet.Range("D65536").End(xlUp))
    N = r.Count
    s = "somme"
    For L = N To 1 Step -1
        v = LCase(r(L).Value)
        If InStr(1, v, s) = 0 Then
            r(L).EntireRow.Delete
        End If
    Next L
End Sub

EDIT#1:

The initial version of the macro ignored column C.....try this instead:

Sub SaveSomeRows()
    Dim N As Long, L As Long, r As Range
    Dim s As String, v As String
    Set r = ActiveSheet.Range("D3", ActiveSheet.Range("D65536").End(xlUp))
    N = r.Count
    s = "somme"
    For L = N To 1 Step -1
        v = LCase(r(L).Value & r(L).Offset(-1, 0).Value)
        MsgBox v
        If InStr(1, v, s) = 0 Then
            r(L).EntireRow.Delete
        End If
    Next L
End Sub

Worked for me (first example). Thanks. – bawpie Dec 14 '16 at 11:24 — bawpie, Dec 14 '16 at 11:24

Macro to remove all rows except those containing certain text

1 Answers1