Fuji - H2O
Fuji - H2O

Reputation: 387

How to delete rows in Excel based on certain values

I have a workbook with 10 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.

for example, I would like to keep we.abc.us, ss.boli.us and 3m.mark.us and delete rest of the rows from all the worksheet in the workbook.

Sub delete0rows()

Dim Worksheet As Excel.Worksheet
Dim lastRow As Long
Dim i As Integer

For Each Worksheet In Application.ThisWorkbook.Worksheets
lastRow = Worksheet.Cells(Rows.Count, 1).End(xlUp).Row

i = 1

    Do While i <= lastRow

        If Worksheet.Range("A" & i).Value = 0 Then
        Worksheet.Rows(i).Delete i = i - 1
        lastRow = lastRow - 1
        End
    i = i + 1
    Loop
Next Worksheet
End Sub

Upvotes: 0

Views: 436

Answers (2)

Mark
Mark

Reputation: 49

I found this sub a while back. I cannot remember who the original author was or I would credit them. I did tweak it slightly to pass variables into it

The nice thing about this is you can pass multiple deletion criteria by passing a space separated string

Essentially you can give it a row to start at (in case you have headers) tell it the column to look in, the sheet that column is on and your criteria/criterion. So for example if I want it to start at row 5 checking each row below that on a sheet named 'cleanup' checking column 'D' for the words 'cat' 'dog' and 'fish' I would write

Call DelRow(5,"D","cleanup","cat dog fish")

Public Sub DelRow(DataStartRow As Long, SearchColumn As String, SheetName As String, myTextString As String)
' This macro will delete an entire row based on the presence of a predefined word or set of words.
'If that word or set of words is 'found in a cell, in a specified column, the entire row will be 'deleted
'Note the seperator is a space. To change this modify the split parameter
'EXAMPLE CALL: Call DelRow(1, "AH", "Cut Data", "DEL")

Dim X As Long
Dim Z As Long
Dim LastRow As Long
Dim FoundRowToDelete As Boolean
Dim OriginalCalculationMode As Integer
Dim RowsToDelete As Range
Dim SearchItems() As String

SearchItems = Split(myTextString)

On Error GoTo ResetCalcs
OriginalCalculationMode = Application.Calculation
Application.Calculation = xlCalculationManual

With Worksheets(SheetName)
    LastRow = .Cells(.Rows.Count, SearchColumn).End(xlUp).Row

    Application.StatusBar = "**** Working on the '" & SheetName & "' Sheet: Number of Rows to be scanned(" & LastRow & "). Deletion keyword " & myTextString & " ***" 'Extra line added

    For X = LastRow To DataStartRow Step -1

        FoundRowToDelete = False

        For Z = 0 To UBound(SearchItems)
            If InStr(.Cells(X, SearchColumn).Value, SearchItems(Z)) Then
                FoundRowToDelete = True
                Exit For
            End If

        Next

        If FoundRowToDelete Then
            If RowsToDelete Is Nothing Then
                Set RowsToDelete = .Cells(X, SearchColumn)
            Else
                Set RowsToDelete = Union(RowsToDelete, .Cells(X, SearchColumn))
            End If

            If RowsToDelete.Areas.Count > 100 Then
                RowsToDelete.EntireRow.Delete
                Set RowsToDelete = Nothing
            End If
        End If

    Next

End With

If Not RowsToDelete Is Nothing Then
    RowsToDelete.EntireRow.Delete
End If

ResetCalcs:
Application.Calculation = OriginalCalculationMode

End Sub

Upvotes: 0

VBA Pete
VBA Pete

Reputation: 2666

I suggest you introduce reverse For loop using Step -1:

Sub delete0rows()

Dim Worksheet As Excel.Worksheet
Dim lastRow As Long
Dim i As Integer

    For Each Worksheet In Application.ThisWorkbook.Worksheets
    lastRow = Worksheet.Cells(Rows.Count, 1).End(xlUp).Row

        For i = lastRow To 1 Step -1
            If Worksheet.Range("A" & i).Value = 0 Then
            Worksheet.Rows(i).EntireRow.Delete
            End If
        Next i
    Next Worksheet
End Sub

Upvotes: 1

Related Questions