As the photo shows, all my data is on ONE column. The "trigger word" is "Past Car" and want that entire row PLUS the two rows under it deleted.
So according to the photo below rows 5,6,7 and 18,19,20 and 26,27,28 would be deleted.
Is this possible with VBA? I've tried using search functions and some VBA techniques but got overwhelmed.
Screenshot
I would suggest to do it like that
Option Explicit
Sub DelIt()
Const PAST_CAR = "Past Car"
Const OFF_SET = 3
Dim lastRow As Long, i As Long
Dim ws As Worksheet
Dim deleteRange As Range
Set ws = ActiveSheet
lastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
With ws
For i = 1 To lastRow
If .Cells(i, 1).Value = PAST_CAR Then
If deleteRange Is Nothing Then
Set deleteRange = .Rows(i).Resize(OFF_SET)
Else
Set deleteRange = Union(deleteRange, .Rows(i).Resize(OFF_SET))
End If
End If
Next i
End With
If Not (deleteRange Is Nothing) Then
deleteRange.EntireRow.Delete
End If
End Sub
In this way you do not need to loop backwards or turn of ScreenUpdatings as you only have one "write" access to the sheet.
You must loop through the cells in column A in reverse order and check if the cell content is Past Car and if so, delete the rows accordingly.
You may try something like this...
Sub DeleteRows()
Dim lr As Long, i As Long
Application.ScreenUpdating = False
lr = Cells(Rows.Count, "A").End(xlUp).Row
For i = lr To 1 Step -1
If Cells(i, 1) = "Past Car" Then
Range("A" & i).Resize(3).EntireRow.Delete
End If
Next i
Application.ScreenUpdating = True
End Sub
Related
I've seen similar posts out there but not quite the same and seem to be confused on the results I'm getting...
I essentially need to de-dupe a column on LIKE words, so it's somewhat straightforward but apparently not as easy as I thought.
I have a dataset like soo...
When I run my macro it removes rows (as I intended), but doesn't seem to remove all the rows or the wrong rows...
It actually removes the highlighted/yellow rows
I was thinking it should actually remove something like the bottom rows.. where it would keep "aerospace" but remove "aerospace 2019", since the 2019 is kinda redundant and not applicable to me.
My macro is simple, but I thought it would do the trick... what am I doing wrong?
Sub container()
Dim ws As Worksheet, rw As Long, col As Long, i As Long
Set ws = ActiveSheet 'or whatever
i = 2
'For col = 2 To 5 'placeholder in case multiple columns are needed - remove Set col above
For rw = 2 To ws.Cells(Rows.Count, 1).End(xlUp).Row 'from row 1 til last non-empty row
v = ws.Cells(rw, 2).Value 'set range
If Cells(i, 2).Value Like v Then 'determine if the cell contains the value of the word
Cells(i, 2).EntireRow.Delete 'delete
i = i + 1
End If
Next rw
'Next col
End Sub
After Ron's post I was able to create the below, but appears I'm still stuck. I think I've just been looking at this too long.
Sub container()
Dim ws As Worksheet, rng As Range, i As Long, rw As Long
Set ws = ActiveSheet 'or whatever
Set rng = ws.Range("B2:B" & ws.Cells(ws.Rows.Count, "B").End(xlUp).Row) 'set array range
i = Range("B" & Rows.Count).End(xlUp).Row
For rw = ws.Cells(Rows.Count, 1).End(xlDown).Row To 2
v = ws.Cells(rw, 2).Value
If InStr(1, v, rng) > 0 Then
cell.EntireRow.Delete
i = i - 1
End If
Next rw
End Sub
UPDATE:
Data set is made of strings that are number though (I don't get it) -> I can do all the math stuff with them as with regular numbers.
Problem is I need to separate cells that look like this "186.85" and cells that look like this "1.76 Dividend".
====================
I need a loop to check row by row if the cell contains some text (word "dividend" specifically) or if it's just number. If it is a text, then delete it and move to the next row.
It does some deleting BUT it wipes like 50 rows of data almost every time (I have only two text populated rows in this particular data set). These rows are numbers.
Dim i As Long
i = 2
Do
If WorksheetFunction.IsText(Sheets("Data").Cells(i, 5)) = True Then
If Not Worksheets("Data").Cells(i, 5).Value = "" Then
Worksheets("Data").Rows(i).Delete
End If
End If
i = i + 1
Loop Until i = 100
I expected to loop through the data and delete the entire row if a cell contains text.
This code so far deletes things kinda randomly.
The below has been updated to a dynamic range. This will not need modification regardless of how many rows your sheet has.
More importantly, deleting rows inside a loop will cause your range to shift at every deletion. The way around this is to loop backwards
OR, even better..
Don't delete cells inside your loop. Every time your criteria is met, you force an action (deletion). Instead, gather up all of the cells to be deleted inside your loop and then delete the entire collection (Union) all at once outside of the loop. This requires 1 action in total rather 1 action per text instance
Sub Looper()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<-- Update sheet name
Dim i As Long, LR As Long
Dim DeleteMe As Range
LR = ws.Range("E" & ws.Rows.Count).End(xlUp).Row
For i = 2 To LR
If WorksheetFunction.IsText((ws.Range("E" & i))) Then
If Not DeleteMe Is Nothing Then
Set DeleteMe = Union(DeleteMe, ws.Range("E" & i))
Else
Set DeleteMe = ws.Range("E" & i)
End If
End If
Next i
If Not DeleteMe Is Nothing Then DeleteMe.EntireRow.Delete
End Sub
Try something like this:
Sub test()
Dim i As Long
For i = 100 To 2 Step -1
With ThisWorkbook.Worksheets("Data")
If WorksheetFunction.IsText(.Cells(i, 5)) = True Then
If Not .Cells(i, 5).Value = "" Then
.Rows(i).EntireRow.Delete
End If
End If
End With
Next i
End Sub
You can use SpecialCells with xlCellTypeConstants-2... No need for a loop. See Range.SpecialCells method (Excel) and XlSpecialCellsValue enumeration (Excel)
Is this what you are trying?
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim rng As Range
'~~> Change this to the relevant sheet
Set ws = Sheet1
With ws
On Error Resume Next
Set rng = .Columns(5).SpecialCells(xlCellTypeConstants, 2)
On Error GoTo 0
If Not rng Is Nothing Then rng.EntireRow.Delete
End With
End Sub
Thank you all for quick responses and effort.
I managed to get this solution working with InStr() function:
''loop through the Data and remove all rows containing text (Dividend payments which we don't need)
Dim i As Long
Dim ws As Worksheet
Dim searchText As String
Dim searchString As String
i = 2
Set ws = Sheets("Data")
Do Until ws.Cells(i, 2).Value = ""
searchText = "Dividend"
searchString = ws.Cells(i, 2).Value
If InStr(searchString, searchText) Then
ws.Rows(i).Delete
End If
i = i + 1
Loop
I run my VBA code and the first time it runs I get the result I want but if I run it a second time my column headers get deleted. FYI my table starts on E and goes through N. My button is on column O and also gets deleted when I run it a second time.
Switching the Range did not help and setting AutoFilter to false also did not work.
#
Sub Auto_filter()
Dim sh As Worksheet
Set sh = ThisWorkbook.Worksheets("HP Service Manager")
sh.AutoFilterMode = False
With sh
On Error Resume Next
.ShowAllData
.Range("E1:N1").AutoFilter 1, "IM*"
AutoFilter = False
End With
End Sub
#
Expect to not have column headers deleted.
The issue is in the second code you shared.
The code is first setting the range here:
Set Rng = Range("E1", Cells(iRow, "E"))
And then here it is trying to delete all visible cells in the range (after applying the filter)
Rng.SpecialCells(xlCellTypeVisible).EntireRow.Delete
which also includes your header cell.
So, a simple way to deal with it could be to set another range like this
Set Rng2 = Range("E2", Cells(iRow, "E"))
and then using it to delete the data
Rng2.SpecialCells(xlCellTypeVisible).EntireRow.Delete
Here is the re-written function for your reference. This only deletes the rows starting from row 2 that are blank. You may want to add some error handing in case there are no blank rows to delete etc.
Sub DeleteRowsAll()
Dim iRow As Long
Dim Rng As Range
Application.ScreenUpdating = False
Rows(1).Insert
Range("E1").Value = "rabbitohs"
With ActiveSheet
.UsedRange
iRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
Set Rng = Range("E1", Cells(iRow, "E"))
Rng.AutoFilter Field:=1, Criteria1:=""
Set Rng2 = Range("E2", Cells(iRow, "E"))
Rng2.SpecialCells(xlCellTypeVisible).EntireRow.Delete
.UsedRange
End With
End Sub
Sub DeleteRowsAll()
Dim LastRow As Long
Dim CellValue As String
LastRow = Worksheets("HP Service Manager").Cells(Rows.Count, "E").End(xlUp).Row
For i = LastRow To 2 Step -1
CellValue = Worksheets("HP Service Manager").Cells(i, "E").Value
If CellValue = "" Then
Worksheets("HP Service Manager").Rows(i).Delete
End If
Next i
End Sub
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
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
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
I am trying to delete duplicate values in a temporary list based on a value in a combobox. The code below loops through individual rows to check whether a value matches. It is slow.
Dim ws As Worksheet
Dim i As Long
Set ws = Sheets("TempList3")
On Error Resume Next
For i = Cells(Rows.Count, 2).End(xlUp).Row To 1 Step -1
If Cells(i, 2) <> Sheets("Sheet1").ComboBox2.Value Then
ws.Rows(i).EntireRow.Delete
End If
Next
Is there a way to evaluate the entire column's values against the combobox's value once and then delete all rows on a worksheet. Or perhaps there is a better way?
I used a looping Find function, it deletes the row where the value was found and then it searches again and deletes the next row it finds until it can no longer find the Combo value on the sheet:
Sub find_cell()
Dim find_cell As Range
Set ws = Sheets("TempList3")
stop_loop = False
Do Until stop_loop = True
Set find_cell = ws.Cells.Find(What:=Sheets("Sheet1").ComboBox2.Value, LookAt:=xlWhole)
If Not find_cell Is Nothing Then
ws.Rows(find_cell.Row).EntireRow.Delete
Else
stop_loop = True
End If
Loop
End Sub
Not knowing how many rows you are talking about, I used 10 thousand for my example codes. here are two examples, try the both and see what works best for you.
You can run through the column and unionize the range found, then delete the rows, for example.
See here for example workbook
Sub UnIonRng()
Dim FrstRng As Range
Dim UnIonRng As Range
Dim c As Range, s As String
s = Sheets("Sheet1").ComboBox2
Set FrstRng = Range("B:B").SpecialCells(xlCellTypeConstants, 23)
For Each c In FrstRng.Cells
If c = s Then
If Not UnIonRng Is Nothing Then
Set UnIonRng = Union(UnIonRng, c) 'adds to the range
'MsgBox UnionRng.Address 'remove later
Else
Set UnIonRng = c
End If
End If
Next c
UnIonRng.EntireRow.Delete
End Sub
Or you can try to filter the column B and delete the rows that way:
Sub FilterDeleteRow()
Dim ws As Worksheet
Dim LstRw As Long, Rng As Range, s As String, x
Set ws = Sheets("TempList3")
s = Sheets("Sheet1").ComboBox2
Application.ScreenUpdating = 0
With ws
LstRw = .Cells(.Rows.Count, "B").End(xlUp).Row
x = Application.WorksheetFunction.CountIf(.Range("B:B"), s)
If x > 0 Then
Columns("B:B").AutoFilter Field:=1, Criteria1:=s
Set Rng = .Range("B2:B" & LstRw).SpecialCells(xlCellTypeVisible)
Rng.EntireRow.Delete
.AutoFilterMode = 0
Else: MsgBox "Not Found"
End If
End With
End Sub