VBA to delete rows in Excel if it does not contain certain values

Question

I have a workbook with 20 sheets. Each sheet has about 30,000 rows with URL. I have a hand full of URLs (about 10 different URLs) that I need to keep the data. Is there a way to delete all the rows from all the worksheet if the first column (Column A - URL) does not contain one of the URL.

I have the following vba but it deletes all the rows. I need to keep the row if the value matches what I have coded below. Also It throws 424 error at end (delete all rows as well). Any idea? Any way to just look at column A instead of putting the cell range because it varies between each sheet.

Sub DeleteCells()

    Dim rng As Range, i As Integer

    'Set the range to evaluate to range.
    Set rng = Range("A1:A10000")

    'Loop backwards through the rows
    'in the range that you want to evaluate.
    For i = rng.Rows.Count To 1 Step -1

        'If cell i in the range DOES NOT contains an "x", delete the entire row.
        If rng.Cells(i).Value <> "https://inside.nov.pvt/ip/hse" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/ip/hse/qhseprivate" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/crp/qhse" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/crp/qhse/csa" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/ops/ehqhse" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/ops/hsehw" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/ops/lahse" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/sites/coloproposal/HSEQ AND GENERAL DOCUMENTS" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/sites/coloproposal/HSEQ AND GENERAL DOCUMENTS/LA OPERATIONS MEETING APRIL 2012" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/crp/hse" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/crp/hse/CorpQHSE" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/crp/hse/IP" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/mfg/mfg/HSE" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/mfg/mfg/HSET" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/ops/na/HSE" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/ops/na/HSE/er" Then rng.Cells(i).EntireRow.Delete      
        If rng.Cells(i).Value <> "https://inside.nov.pvt/ops/na/HSE/GCR" Then rng.Cells(i).EntireRow.Delete     
        If rng.Cells(i).Value <> "https://inside.nov.pvt/ops/na/HSE/wr" Then rng.Cells(i).EntireRow.Delete
        If rng.Cells(i).Value <> "https://inside.nov.pvt/ops/mexopex" Then rng.Cells(i).EntireRow.Delete        
    Next

End Sub

with the if statements as you have them all but one will return true each loop thus deleting the row. You need one If using `And` between the checks `If rng.Cells(i).Value <> "https://inside.nov.pvt/ip/hse" And rng.Cells(i).Value <> "https://inside.nov.pvt/ip/hse/qhseprivate" And ...` — Scott Craner, Feb 02 '17 at 20:32
You're deleting everything but https://inside.nov.pvt/ip/hse in your first command. And then you are deleting everything else with your second command. Put all the urls you want to keep into an array. Do multiple .find on all of your needed urls and put their row numbers into a second array. create a temporary second worksheet and go down and copy each row in that array, 1 by 1, to the new worksheet. Then clear the main worksheet, and copy the data from the new worksheet back onto the old one. Then kill the new worksheet. — John Muggins, Feb 02 '17 at 20:52
Hi John, Great Idea. do you have any sample of it? I appreciate it. — Fuji - H2O, Feb 02 '17 at 21:04
Can't post my answer, but you can construct an array with your handfull URLs, and then check if your row value is in the array. I almost post an answer base in [this one](http://stackoverflow.com/a/11112305/1726522). Just add an extra loop for the worksheets, and replace `Row(cell.Row).Style = "Accent1"` with `rng.Cells(i).EntireRow.Delete`. And of course the fruits with your URLs.... — CMArg, Feb 02 '17 at 21:16

score 1 · Accepted Answer · answered Feb 02 '17 at 21:36

Try this to create and populate a new sheet. You'll have to add your own code to put it where you want it.

Sub saveImportantData()
    Dim myUrlArray, oldSheetRowArray, arrayCounter As Long
    Dim tempWS As Worksheet, myWS As Worksheet, newSheetRowCounter As Long

    ReDim oldSheetRowArray(1 To 1)
    Set myWS = ActiveSheet
    Set tempWS = Sheets.Add(After:=Sheets(Worksheets.Count))

    newSheetRowCounter = 1
    arrayCounter = 1
    myUrlArray = Array("https://inside.nov.pvt/ip/hse", _
                    "https://inside.nov.pvt/ip/hse/qhseprivate", _
                    "https://inside.nov.pvt/crp/qhse", _
                    "https://inside.nov.pvt/crp/qhse/csa", _
                    "https://inside.nov.pvt/crp/qhse/csa", _
                    "https://inside.nov.pvt/ops/ehqhse", _
                    "https://inside.nov.pvt/ops/hsehw", _
                    "https://inside.nov.pvt/ops/lahse", _
                    "https://inside.nov.pvt/sites/coloproposal/HSEQ AND GENERAL DOCUMENTS", _
                    "https://inside.nov.pvt/sites/coloproposal/HSEQ AND GENERAL DOCUMENTS/LA OPERATIONS MEETING APRIL 2012", _
                    "https://inside.nov.pvt/crp/hse", _
                    "https://inside.nov.pvt/crp/hse/CorpQHSE", _
                    "https://inside.nov.pvt/crp/hse/IP", _
                    "https://inside.nov.pvt/mfg/mfg/HSE", _
                    "https://inside.nov.pvt/mfg/mfg/HSET", _
                    "https://inside.nov.pvt/ops/na/HSE", _
                    "https://inside.nov.pvt/ops/na/HSE/er", _
                    "https://inside.nov.pvt/ops/na/HSE/GCR", _
                    "https://inside.nov.pvt/ops/na/HSE/wr", _
                    "https://inside.nov.pvt/ops/mexopex")

    For i = 1 To UBound(myUrlArray)
       With myWS.Range("A1:A10000")
        Set c = .Find(myUrlArray(i), LookIn:=xlValues)
            If Not c Is Nothing Then
                firstAddress = c.Address
                Do
                    oldSheetRowArray(arrayCounter) = c.Row
                    arrayCounter = arrayCounter + 1
                    ReDim Preserve oldSheetRowArray(1 To arrayCounter)
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> firstAddress
            End If
        End With
    Next i


    Application.ScreenUpdating = False
    For k = 1 To UBound(oldSheetRowArray)
        If oldSheetRowArray(k) <> "" Then
            myWS.Activate
            myWS.Rows(oldSheetRowArray(k) & ":" & oldSheetRowArray(k)).Select
            Selection.Copy
            tempWS.Activate
            tempWS.Range("A" & newSheetRowCounter).Select
            ActiveSheet.Paste
            newSheetRowCounter = newSheetRowCounter + 1
        End If
    Next k
    Application.ScreenUpdating = True

    Set myWS = Nothing
    Set tempWS = Nothing
    Set c = Nothing

End Sub

Thanks so much for the code. I will try it and let you know. I appreciate it. — Fuji - H2O, Feb 03 '17 at 16:54
Works perfectly. It create a new worksheet then I just have to copy the row 1 for Titles and delete the old sheet. Thanks John. — Fuji - H2O, Feb 03 '17 at 17:15

VBA to delete rows in Excel if it does not contain certain values

1 Answers1