Delete row if cells equal a set of values - excel

I created a macro to in order to generate a daily report. The portion of the macro that finds a value in column AN and deletes the entire row (code edited to delete rows starting from the last used row), works well.
The following example deletes all the rows that do not contain the value "CAT","BAT", or "DOG in column AN.
'False screen updating
Application.ScreenUpdating = False
'deleting all other types other than CAT from "samples" tab (excluding the header row, row 1)
Sheets("sample").Select
Lastrow = Cells(Rows.Count, "AN").End(xlUp).Row
'Deleting rows from bottom up
For i = Lastrow To 2 Step -1
If Range("AN" & i).Value <> "CAT" And _
Range("AN" & i).Value <> "BAT" And _
Range("AN" & i).Value <> "DOG" Then
Rows(i).EntireRow.Delete
End If
Next i
However, would like to create another Sub that deletes all the rows that do contain a specific set of values.
I tried replacing <> with = and ==, however neither worked and no rows were deleted

Below is a sample how to delete rows based on a criteria in column A. Keep in mind that if we delete rows we go backwards to avoid index errors.
Try:
Option Explicit
Sub test()
Dim Lastrow As Long, i As Long
With ThisWorkbook.Worksheets("Sheet1")
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
'Where you delete you go backwards
For i = Lastrow To 2 Step -1
If .Range("A" & i).Value = "CAT" Then
.Rows(i).EntireRow.Delete
End If
Next i
End With
End Sub

Thank you everyone for help resolving this issue. I have found that the root cause of my problem was simply the condition statement at the end of my If/Then line. The "And_" statement was saying "If cell equals CAT and BAT and DOG, then delete row" NOT "If cell equals CAT or BAT or DOG, then delete row". Replacing "And_" with "Or_" has fixed this issue.
'False screen updating
Application.ScreenUpdating = False
'deleting all other types other than CAT from "samples" tab (excluding the header row, row 1)
Sheets("sample").Select
Lastrow = Cells(Rows.Count, "AN").End(xlUp).Row
'Deleting rows from bottom up
For i = Lastrow To 2 Step -1
If Range("AN" & i).Value = "CAT" Or _
Range("AN" & i).Value = "BAT" Or _
Range("AN" & i).Value = "DOG" Or _
Range("AN" & i).Value = "" Then
Rows(i).EntireRow.Delete
End If
Next i
However, I would also like to delete rows if the cells is Blank "". Why would the Sub ignore this line?
Range("AN" & i).Value = "" Then
Thanks!

A site that might be able to help you be the following.
https://www.excelcampus.com/vba/delete-rows-cell-values/
I adjusted the code a little.
Sub Delete_Rows_Based_On_Value()
'Apply a filter to a Range and delete visible rows
'Source: https://www.excelcampus.com/vba/delete-rows-cell-values
Dim ws As Worksheet
'Set reference to the sheet in the workbook.
Set ws = ThisWorkbook.Worksheets("sampel")
ws.Activate 'not required but allows user to view sheet if warning message appears
'Clear any existing filters
On Error Resume Next
ws.ShowAllData
On Error GoTo 0
'1. Apply Filter
ws.Range("AN3:BG1000").AutoFilter Field:=1, Criteria1:="<>CAT"
'2. Delete Rows
Application.DisplayAlerts = False
ws.Range("B1:G1000").SpecialCells(xlCellTypeVisible).Delete
Application.DisplayAlerts = True
'3. Clear Filter
On Error Resume Next
ws.ShowAllData
On Error GoTo 0
End Sub

I would tend to do it this way:
Sub DeleteRows()
Dim i As Integer
Dim sht As Worksheet
Set sht = ThisWorkbook.Sheets("sample")
i=1
While sht.(i,1) <> "" 'Assuming first column is full of data to the bottom
If sht.Range("AN" & i) = "CAT" Then
sht.Rows(i).EntireRow.Delete
Else
i=i+1
End If
Wend
End Sub

Related

Copy and Pasting to a new worksheet

I am using the code below to copy and paste the row to a new worksheet. When testing manually it seems to work but when running macro excel freezes. Basically if column L has the word Completed it shoud copy and paste that row to the Completed worksheet then return and delete the original row (everything with the work completed should be moved to completed folder)
Public Sub Completed()
Application.ScreenUpdating = False
Sheets("BPM-Other").Select
FinalRow = Range("L11579").End(xlUp).Row
For x = FinalRow To 2 Step -1
ThisValue = Range("L" & x).Value
If ThisValue = "Completed" Then
Range("A" & x & ":O" & x).Cut
Sheets("BPM_Other Completed").Select
nextrow = Range("L10500").End(xlUp).Row + 1
Range("A" & nextrow).Select
ActiveSheet.Paste
Sheets("BPM-Other").Select
Range("A" & x & ":L" & x).Delete Shift:=xlUp
End If
Next x
Application.ScreenUpdating = True
End Sub
I used, excel filter and copy, filter and delete option to accomplish the work. Please have a look at the below code.
Logic I used here is- Filter 12th column with value 'Completed'-> Insert the filtered rows into target sheet, starting after last used row -> Delete all the Completed rows in source sheet -> Remove the filter in source sheet
Sub filter()
'specify sheet name
src = "BPM-Other"
tar = "BPM_Other Completed"
'calculating last used rows in both source and target sheet
src_last = Sheets(src).Cells(Rows.Count, "A").End(xlUp).Row
tar_last = Sheets(tar).Cells(Rows.Count, "A").End(xlUp).Row
With Sheets(src)
.AutoFilterMode = False
'assuming O is your last column, change as needed
With .Range("A1:O" & src_last)
'L is 12th column
.AutoFilter Field:=12, Criteria1:="Completed"
'Offset used to ignore the header
.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy Destination:=Sheets(tar).Range("A" & tar_last + 1)
'delete the rows
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
End With
'to remove the filter in source sheet
On Error Resume Next
Sheets(src).ShowAllData
On Error GoTo 0
End Sub

If blank in A, delete cells in column A to J

I'm struggling to adapt my code now I've built out my sheet.
My code to clear the whole row is
Sub dontdeleteallrows()
Dim a
a = [MATCH(TRUE,INDEX(ISNUMBER(A1:A10000),0),0)]
If Not IsNumeric(x) Then Exit Sub
Rows(a & ":" & Rows.Count).Delete
End Sub
What can I replace Rows(a & ":" & Rows.Count).Delete with to delete cells AA to JA?
Do you want to delete the cells or clear them of content?
If you want to delete the cells, other content may need to move left or up. Where do you want it to go?
You might do something like
Range("Aa" & a & ":Ja" & a).clear
If you want to check Column A for empty cell value and delete the entire row you could use the below:
Option Explicit
Sub Delete()
Dim LastRow As Long, i As Long
With ThisWorkbook.Worksheets("Sheet1")
'Find the last row
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'Loop column A
For i = LastRow To 1 Step -1
'Check if cell is empty
If .Range("A" & i).Value = "" Then
'Delete row
.Rows(i).EntireRow.Delete
End If
Next i
End With
End Sub

Deleting Rows Based on Text Values in Specific Column

I have written a short macro to delete all rows that have a value of "Not Applicable" in column I, for the "Budget" tab of my workbook.
The macro does not seem to be doing anything when I run it through my testing:
Sub Remove_NA_Macro_Round_2()
With Sheets("Budget") 'Applying this macro to the "Budget" sheet/tab.
'Establishing our macro range parameters
Dim LastRow As Long
Dim i As Long
'Setting the last row as the ending range for this macro
LastRow = .Range("I50").End(xlUp).Row
'Looping throughout all rows until the "LastRow" ending range set above
For i = LastRow To 1 Step -1
If .Range("I" & i).Value = "Not Applicable" Then
.Range("I" & i).EntireRow.Delete
End If
Next
End With
End Sub
I appreciate any help!
Alternatively, when deleting rows based on a condition, it is faster to use a filter then looping.
Dim rng As Range
Set rng = ThisWorkbook.Sheets("Sheet1").Range("A1:I" & Cells(Rows.Count, "I").End(xlUp).Row)
Application.DisplayAlerts = False
With rng
.AutoFilter
.AutoFilter field:=9, Criteria1:="Not Applicable"
rng.Resize(rng.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Delete 'deletes the visible rows below the first row
.AutoFilter
End With
Application.DisplayAlerts = True
You are not actually referencing the With Sheets("Budget"). Add a period . before each instance of Range, otherwise there's an implicit ActiveSheet, which is not necessarily the Budget tab.
With Sheets("Budget")
...
LastRow = .Range("I50").End(xlUp).Row
...
If .Range("I" & i).Value = "Not Applicable" Then
.Range("I" & i).EntireRow.Delete
End If
...
End With
EDIT:
Based on commentary and your provided screenshot, change how LastRow is determined (get rid of the hard-coded I50):
LastRow = .Cells(.Rows.Count, "I").End(xlUp).Row

VBA: Next Empty Row Randomly Overwriting Some Rows

I have a list of files:
They share one common format, only have one sheet, but can have multiple rows with data. They are meant to be opened, all cells with data copied, and then pasted to a sheet called Addresses. Like this:
However what I'm getting is this:
Now I have stepped in and noticed that my other data IS being put in the destination, it's just getting overwritten (in what appears to be a random pattern). Here's the code I used:
Option Explicit
Sub AddressListing()
Dim Cell As Range
With Worksheets("ghgh")
For Each Cell In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Cells
If Len(Dir(Cell.Value)) Then
With Workbooks.Open(Cell.Value)
Range("A2:X" & Cells(Rows.Count, "D").End(xlUp).Row).copy _
ThisWorkbook.Worksheets("Addresses").Cells(Rows.Count, "A").End(xlUp).Offset(1)
.Close SaveChanges:=False
End With
Else
MsgBox "File not found: " & Cell.Value
End If
Next Cell
End With
'Call RemoveViaFilter
End Sub
In an effort to combat this and not waste everyone's time, I created a NextRow variable to find the next blank row in the workbook. It still didn't work. I don't get an error message, the data is simply input the same way.
Here's the code with NextRow:
Option Explicit
Sub AddressListing2()
Dim Cell As Range
Dim NextRow As Long
NextRow = ThisWorkbook.Sheets("Addresses").Range("D" & Rows.Count).End(xlUp).Row + 1
With Worksheets("ghgh")
For Each Cell In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Cells
If Len(Dir(Cell.Value)) Then
With Workbooks.Open(Cell.Value)
Range("A2:X" & Cells(Rows.Count, "D").End(xlUp).Row).copy _
ThisWorkbook.Worksheets("Addresses").Range("A" & NextRow)
.Close SaveChanges:=False
End With
Else
MsgBox "File not found: " & Cell.Value
End If
Next Cell
End With
'Call RemoveViaFilter
End Sub
I have never encountered that type of error with NextRow. I know 'Find next blank row and put data there' is a common question, which is why I thought NextRow would solve the issue. However, data is still being overwritten and I have not come across any questions that address this.
I don't want defined ranges (like A2:J100 for example) and have purposefully avoided them, because the length of my lists constantly changes. That goes for the rows I want to paste and the rows of file paths.
Any help is much appreciated, I've used the 'find empty row' several times before with no issues, and don't know why it's overwriting data. It seems antithetical to the whole process of find the empty row.
This is where to you put the additional line...
Option Explicit
Sub AddressListing2()
Dim Cell As Range
Dim NextRow As Long
NextRow = ThisWorkbook.Sheets("Addresses").Range("D" & Rows.Count).End(xlUp).Row + 1
With Worksheets("ghgh")
For Each Cell In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Cells
If Len(Dir(Cell.Value)) Then
With Workbooks.Open(Cell.Value)
Range("A2:X" & Cells(Rows.Count, "D").End(xlUp).Row).copy _
ThisWorkbook.Worksheets("Addresses").Range("A" & NextRow)
.Close SaveChanges:=False
End With
Else
MsgBox "File not found: " & Cell.Value
End If
'Add line here before going to new loop
NextRow = ThisWorkbook.Sheets("Addresses").Range("D" & Rows.Count).End(xlUp).Row + 1
Next Cell
End With
'Call RemoveViaFilter
End Sub
It is clear that NextRow is not being calculated correctly. Put some validation code in after you calculate it:
NextRow = ThisWorkbook.Sheets("Addresses").Range("D" & Rows.Count).End(xlUp).Row + 1
While Application.WorksheetFunction.CountA(Rows(NextRow)) <> 0
NextRow = NextRow + 1
Wend
This will insure NextRow will be an empty row.

Trying to delete all Rows until Cell (A,1) has certain value

Having issues in VBA
Trying to delete all rows until value in row 1 = "**GRAD*"
I get Runtime Error 438
Code Below
Public Sub Delete()
Dim i As Long
i = 1 'Start from row 1
Application.ScreenUpdating = False
With ThisWorkbook.Worksheets("Sheet1")
Do Until .Range("A" & i).Value = "**GRAD"
If .Rage("A" & i).Value <> "**GRAD" Then
.Rows(i).EntireRow.Delete
Else: i = i + 1 'Only increment if the row hasn't been deleted to prevent skipping rows
End If
Loop
End With
Application.ScreenUpdating = True
End Sub
Some help would be appreciated, new to VBA.
L.Dutch already gave you the answer to your question
here's an alternative and faster approach
to delete all rows until value in column 1 = "**GRAD*"
Option Explicit
Public Sub Delete()
Dim lastRowToDelete As Long
Dim f As Range
With ThisWorkbook.Worksheets("Sheet0001") '<-- reference your worksheet
With Range("A1", .Cells(.Rows.Count, 1).End(xlUp)) '<-- reference its columns "A" cells from row 1 sown to last not empty one
Set f = .Find(what:="**GRAD", LookIn:=xlValues, lookat:=xlWhole, after:=.Range("A" & .Rows.Count)) '<-- look for the first cell whose value is "**GRAD"
If f Is Nothing Then '<-- if not found then...
lastRowToDelete = .Rows(.Rows.Count).Row '<-- the last row to delete is the last row of the range
Else '<-- otherwise...
lastRowToDelete = f.Row - 1 '<-- the last row to delete is the one preceeding the one with the found cell
End If
End With
If lastRowToDelete > 0 Then .Range("A1:A" & lastRowToDelete).EntireRow.Delete 'delete all rows in a single shot
End With
End Sub
Typo? I read If .Rage("A" & i).Value <> "**GRAD" Then while it should be If .Range("A" & i).Value <> "**GRAD" Then

Resources