Reputation: 387
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
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
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