If cell is blank delete entire row [duplicate] - vba

This question already has answers here:
Excel VBA - Delete Rows Based on Criteria
(2 answers)
Closed 4 years ago.
In Excel, I want to delete entire row if a cell is blank.
This should count for A17:A1000.
Running the script it returns the error:
Run-time 1004 error
Method Range of object global failed
If I replace A17:A1000 with A it deletes some rows.
Sub DeleteBlanks()
Dim r As Long
Dim m As Long
Application.ScreenUpdating = False
m = Range("A17:A1000" & Rows.Count).End(xlUp).Row
For r = m To 1 Step -1
If Range("A17:A1000" & r).Value = "" Or Range("A17:A1000" & r).Value = 0 Then
Range("A17:A1000" & r).EntireRow.Delete
End If
Next r
Application.ScreenUpdating = True
End Sub

The main issue in your code is that it is counting wrong.
"A17:A1000" & r does not count the rows up but appends the number r to that string. So eg if r = 500 it will result in "A17:A1000500" but not in "A17:A1500" as you might expected.
To delete all rows where column A has a blank cell you can use
Option Explicit
Public Sub DeleteRowsWithBlankCellsInA()
Worksheets("Sheet1").Range("A17:A1000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
This one deletes all blank lines at once and therefore is pretty fast. Also it doesn't need to disable ScreenUpdating because it is only one action.
Or if blank and zero cells need to be deleted use
Option Explicit
Public Sub DeleteRowsWithBlankOrZeroCellsInA()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1") 'define which worksheet
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim iRow As Long
For iRow = LastRow To 1 Step -1
If ws.Cells(iRow, "A").Value = vbNullString Or ws.Cells(iRow, "A").Value = 0 Then
ws.Rows(iRow).Delete
End If
Next iRow
End Sub
This one deletes line by line. Each delete action takes its time so it takes longer the more lines you delete. Also it might need to disable ScreenUpdating otherwise you see the line-by-line action.
An alternative way is to collect all the rows you want to delete with Union() and then delete them at once.
Option Explicit
Public Sub DeleteRowsWithBlankOrZeroCellsInA()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1") 'define which worksheet
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim DeleteRange As Range
Dim iRow As Long
For iRow = LastRow To 1 Step -1 'also forward looping is possible in this case: For iRow = 1 To LastRow
If ws.Cells(iRow, "A").Value = vbNullString Or ws.Cells(iRow, "A").Value = 0 Then
If DeleteRange Is Nothing Then
Set DeleteRange = ws.Rows(iRow)
Else
Set DeleteRange = Union(DeleteRange, ws.Rows(iRow)) 'collect rows to delete
End If
End If
Next iRow
DeleteRange.Delete 'delete all at once
End Sub
This is also pretty fast because you have again only one delete action. Also it doesn't need to disable ScreenUpdating because it is one action only.
In this case it is also not necessary to loop backwards Step -1, because it just collects the rows in the loop and deletes at once (after the loop). So looping from For iRow = 1 To LastRow would also work.

There are multiple errors in your code.
First of all, your procedure should have it's scope declared.
Presumably in your case Private
You are incorrectly defining your Range() Please look at its definition
Range.Value = 0 is not the same as Range = "" or better yet IsEmpty(Range)
Looping from beginning to end when deleting individual rows will cause complications (given their indexes [indices(?)] change) - or to better word myself - it is a valid practice, but you should know what you're doing with the indexes. In your case it seems much easier to them them in the LIFO order.
Last but not least, you're unnecessarily complicating your code with certain declarations (not an error so to say, but something to be improved upon)
With all the considered, your code should look something like this:
Option Explicit
Private Sub remove_empty_rows()
Dim ws as Worksheet: Set ws = Sheets("Your Sheet Name")
Dim lr as Long
lr = ws.Cells(Rows.Count, 1).End(xlUp).Row
Dim i as Long
For i = lr to 1 Step -1
If IsEmpty(ws.Cells(i, 1)) Then
ws.Rows(i).Delete
End If
Next i
End Sub
In general, without meaning to sound condescending, it looks like you have some learning gaps in your coding practice. I'd refer properly reading some documentation or tutorial first, before actually doing coding like this yourself.

Taking into account that A17 cell is a header, you could use AutoFilter instead of iterating over cells:
Sub FastDeleteMethod()
Dim rng As Range, rngFiltered As Range
Set rng = Range("A17:A" & Cells(Rows.Count, "A").End(xlUp).Row)
With rng
.AutoFilter Field:=1, Criteria1:=0, Operator:=xlOr, Criteria2:="="
On Error Resume Next
Set rngFiltered = rng.SpecialCells(xlCellTypeVisible)
If Err = 0 Then rngFiltered.EntireRow.Delete
On Error GoTo 0
End With
End Sub

Related

Looking for specific contents in each of the cells in the column and delete the row in some cases

I'm trying to take the output of our scheduling software for a TV station and get rid of anything for given times. Unfortunately the output of the scheduling software creates a text field for time, not a field that can be formatted to time. I haven't done any real programming in over a decade and this is frustrating me. Here's a sample of the first few rows of the sheet - every day of the month contains entries for each program from 6:00a to the next day at 5:30a.
The code I've got so far is:
Sub delete_extraneous()
Dim rng As Range
Dim j As Integer
Dim m As Integer
m = 1
j = 3
Goto ActiveSheet.Cells(j, m)
With ActiveSheet
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
For m = 1 To lastRow
If rng = "6:30a" Or "7:00a" Or "7:30a" Or "8:00a" Or "8:30a" Or "9:00a" Or "9:30a" Or "10:00a" Or "10:30a" Or "11:00a" Or "11:30a" Then
ActiveCell.EntireRow.Delete Shift:=xlShiftUp
End If
Next m
End Sub
Use an array of text-that-looks-like-time and match against it.
Sub delete_extraneous()
dim tms as variant, lastRow as long
tms = array("6:30a", "7:00a", "7:30a", "8:00a", "8:30a", "9:00a", "9:30a", _
"10:00a", "10:30a", "11:00a", "11:30a")
with activesheet
lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
For m = lastRow to 1 step-1
If not iserror(application.match(.Cells(m, "C").value, tms, 0)) Then
.rows(m).EntireRow.Delete Shift:=xlShiftUp
End If
Next m
.
end with
end sub
You could use Autofilter():
Sub test()
Dim hours As Variant
hours = Array("6:30a", "7:00a", "7:30a", "8:00a", "8:30a", "9:00a", "9:30a", "10:00a", "10:30a", "11:00a", "11:30a")
With Range("C1", Cells(Rows.Count, 3).End(xlUp))
.AutoFilter Field:=1, Criteria1:=hours, Operator:=xlFilterValues
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
If Not IsError(Application.Match(.Cells(1, 1).value, hours, 0)) Then .Rows(1).Delete
End With
ActiveSheet.AutoFilterMode = False
End Sub
You don't state what your specific issue is in the code, but I can tell you a few problems you have.
1) This is not valid syntax Goto ActiveSheet.Cells(j, m). There is a GoTo statement in VBA, but only use when absolutely necessary. (this case does not require it).
2) Don't rely on ActiveSheet. Instead reference the selected worksheet you desire to work with directly.
3) You never actually define rng so it's meaningless and your code will always bypass range. Using Option Explicit at the top of your modules can help avoid this issue.
4) Using active cell is also dangerous and may produce unintended consequences. In your case it will delete the same cell over and over and over again since you never activate any other cell. It's not needed.
See this code below. It also checks for row deletion and loads into a range for one delete statement later (which will be faster than deleting line by line, and doesn't require backwards looping).
Option Explicit
Sub delete_extraneous()
Dim mySheet As Worksheet
Set mySheet = Worksheets("mySheet") 'replace as needed
Dim lastRow As Long
lastRow = mySheet.Cells(mySheet.Rows.Count, 1).End(xlUp).Row
Dim m As Long
For m = 1 To lastRow
Select Case mySheet.Cells(m, 3).Value 'check each row against column C
Case Is = "6:30a", "7:00a", "7:30a", "8:00a", "8:30a", "9:00a", "9:30a", "10:00a", "10:30a", "11:00a", "11:30a"
Dim deleteRng As Range
If deleteRng Is Nothing Then
Set deleteRng = mySheet.Cells(m, 3)
Else
Set deleteRng = Union(deleteRng, mySheet.Cells(m, 3))
End If
End Select
Next
deleteRng.EntireRow.Delete
End Sub

Invalid or unqualified reference error using .Cells

I'm trying to create excel template (the volume of data will be different from case to case) and it looks like this:
In every even row is "Customer" and I would like to put in every odd row "Ledger". Basically it should put "Ledger" to every odd row until there are data in column C. I have this code:
'========================================================================
' INSERTING LEDGERS for every odd row (below Customer)
'========================================================================
Sub Ledgers()
Dim rng As Range
Dim r As Range
Dim LastRow As Long
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
Set rng = .Range("C5:C" & LastRow)
For i = 1 To rng.Rows.Count
Set r = rng.Cells(i, -2)
If i Mod 2 = 1 Then
r.Value = "Ledger"
End If
Next i
End Sub
But it gives me an error msg Invalid or unqualified reference. Could you advise me, where I have the error, please?
Many thanks!
If a command starts with . like .Cells it expects to be within a with statement like …
With Worksheets("MySheetName")
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
Set rng = .Range("C5:C" & LastRow)
End With
So you need to specify the name of a worksheet where the cells are expected to be in.
Not that it would be a good idea to use Option Explicit at the top of your module to force that every variable is declared (you missed to declare i As Long).
Your code could be reduced to …
Option Explicit
Public Sub Ledgers()
Dim LastRow As Long
Dim i As Long
With Worksheets("MySheetName")
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
'make sure i starts with a odd number
'here we start at row 5 and loop to the last row
'step 2 makes it overstep the even numbers if you start with an odd i
'so there is no need to proof for even/odd
For i = 5 To LastRow Step 2
.Cells(i, "A") = "Ledger" 'In column A
'^ this references the worksheet of the with-statement because it starts with a `.`
Next i
End With
End Sub
Just loop with a step 2 to get every other row in your indexer variable.
Sub Ledgers()
Dim rng As Range
Dim LastRow As Long
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "C").End(xlUp).Row
Set rng = ActiveSheet.Range("C5:C" & LastRow)
For i = 1 To LastRow step 2
rng.Cells(i, 1) = "Ledger" 'In column A
Next i
End Sub

Excel VBA Delete Row based on column value

I wanted to write a Excel Macro that goes though K1--->K(lastrow) and looks for the value "OptedOut", and if it finds that value then it deletes that row. I appreciate the help guys. The only part that is wrong is the For Each C part, because I don't understand arrays, and possibly "c.Value = "OptedOut" Then Rows(c).Delete" kinda pulled that out of my ass.
Thanks all!
Sub DuplicateDelete()
Sheets("ALL CLIENTS").Range("A1:J10000").Copy Destination:=Sheets("ClientsAndEmailsThatAreOK").Range("A1:J10000")
With ActiveSheet
LastRow = .Cells(.Rows.Count, "K").End(xlUp).Row
MsgBox LastRow
End With
'Dim c As Range
For Each c In Range(Range(Cells("K1"), Cells(LastRow, "K")))
If c.Value = "OptedOut" Then Rows(c).Delete
Next c
End Sub
Loop backwards when deleting rows (or other objects).
Also, instead of using ActiveSheet try to fully qualify your Worksheet object, such as Sheets("ClientsAndEmailsThatAreOK").
Try the code below, explanation inside the code's comments:
Option Explicit
Sub DuplicateDelete()
Dim C As Range
Dim i As Long, LastRow As Long
Sheets("ALL CLIENTS").Range("A1:J10000").Copy Destination:=Sheets("ClientsAndEmailsThatAreOK").Range("A1:J10000")
' I'm assuming you want to work with sheet "ClientsAndEmailsThatAreOK" (if not then switch it)
With Sheets("ClientsAndEmailsThatAreOK")
LastRow = .Cells(.Rows.Count, "K").End(xlUp).Row
MsgBox LastRow
' always loop backwards when deleting rows
For i = LastRow To 1 Step -1
If .Range("K" & i).Value2 = "OptedOut" Then .Rows(i).Delete
Next i
End With
End Sub

Clear entire row if no content/text/number found in cell

I am writing a VBA script that will delete (clear content) of the entire row if one of the cells within the rows is found to be blank or does not have any text or integer value.
I'm almost there, but I think my code is stuck in the for loop. Please let me know how I can further improve my code.
Sub Remove_Rows_BlankData()
For SheetCount = 1 To Sheets.Count 'SHEET LEVEL
Sheets(SheetCount).Visible = True
Sheets(SheetCount).Select
StartRow = 2
' EndRow = Cells(ActiveSheet.UsedRange.Rows.Count, 34)
LastRow = ActiveSheet.UsedRange.Rows.Count
LastCol = ActiveSheet.UsedRange.Columns.Count
Dim myRange As Range
Set myRange = Range(Cells(StartRow, 1), Cells(LastRow, LastCol))
'REMOVE ROWS W/ ANY BLANK CELLS
Dim DRow As Variant ' Sets DRow = Row w/ Blank
'From start row to last row
Cells.SpecialCells(xlCellTypeBlanks).EntireRow.Select
Selection.ClearContents
Next
End Sub
I've rewritten your sub to avoid having to Select a worksheet in order to use it. By referencing each worksheet in the loop using a With ... End With statement, the cells and properties of each worksheet can be dealt with without resorting to selecting¹ the worksheet just to use the inherent association of the ActiveSheet.
Sub Remove_Rows_BlankData()
Dim ws As Long, fr As Long, lr As Long, lc As Long
On Error Resume Next 'just in case there are no blank cells
For ws = 5 To Worksheets.Count 'SHEET LEVEL
With Worksheets(ws)
.Visible = True
'Sheets(SheetCount).Select 'not necessary to select in order to process
fr = 2
' EndRow = Cells(ActiveSheet.UsedRange.Rows.Count, 34)
lr = .UsedRange.Rows.Count
lc = .UsedRange.Columns.Count
With .Range(.Cells(fr, 1), .Cells(lr, lc))
.SpecialCells(xlCellTypeBlanks).EntireRow.ClearContents
End With
End With
Next ws
End Sub
Note that no variables are created (aka Dim) within the loop; only reassigned values.
¹ See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.

Remove the last two Characters in a cell

I need to remove the last the last two characters of all cells found in a worksheet named Target with the column name Order (column BD).
This macro below would have looked in row 1 Worksheet Target for the word orders. It then would have removed the last two characters (strings).
However since I am new and got these macros from two different sources I likely messed up in assigning variables.
Sub RemoveOrdersTT()
Dim ws As Worksheet
Dim rng As Range
Dim lastCol As Long
Dim i As Long
Set ws = Worksheets("Target")
With ws
lastCol = .UsedRange.Columns.Count
For i = 1 To lastCol
If InStr(1, UCase(.Cells(1, i).Value), "Orders") > 0 Then
.Cells(1, i).Value = Left(.Cells(1, i).Value, Len(.Cells(1, i).Value) - 2)
End If
Next i
End With
End Sub
A code that would look at worksheet Target and column BD starting at row 2 or a fix to my code would be much appreciated.
Change the inner if:
If InStr(1, UCase(.Cells(1, i).Value), "ORDER") > 0 Then
.cells(1,i).value = left(.cells(1,i).value, Len(.cells(1,i).value) -2)
End If
InStr requires 3 parameters (plus some optional ones), you were missing the first parm telling it where to start looking
In the If statement, InStr will return a position or 0, so testing for > 0 is sufficient, no need for <>, though that will work, it's just unnecessary
Remove the 2nd call to UCase() in the if statement itself, no need to UCase a fixed string, just provide it in upper case.
No need to mess with trying to create another range object and modifying that, you've already got the cell you need.
Also:
Assuming your data is rectangular (i.e. you don't have any columns without headers that you don't want to have searched):
LastCol = .UsedRange.Columns.Count
Is a much easier way of finding out how many columns are in use, and doesn't require moving the active cell about the worksheet.
Complete Code
Sub RemoveOrdersTT()
Dim ws As Worksheet
Dim rng As Range
Dim lastCol As Long
Dim i As Long
Dim r as long
Set ws = Worksheets("Target")
With ws
lastCol = .UsedRange.Columns.Count
For i = 1 To lastCol
If InStr(1, UCase(.Cells(1, i).Value), "Orders") > 0 Then
for r = 2 to .usedRange.Rows.Count
.Cells(r, i).Value = Left(.Cells(r, i).Value, Len(.Cells(r,i).Value) - 2)
next
End If
Next i
End With
End Sub
Had to add the inner loop For r... to actually get it to traverse the rows in that column