VBA if cell blank, delete row, if no cells blank, end sequence - vba

I think I need a loop function for this but i'm not sure how to go about it.
The task for this is to see if a specific column is blank, then to delete that row. But sometimes there is no blank cells and i am getting a end debug error.
Here is my code:
Sub DeleteRow()
Dim lr As Long
Dim shCurrentWeek As Worksheet
Set shCurrentWeek = AciveWorkbook.Sheets("Current Week")
lr = shCurrentWeek.Range("A" & Rows.Count).End(xlUp).Row
'Delete Row
shCurrentWeek.Range("B4:B" & lr).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
any ideas?

How about just putting on error resume next right before your Delete line? LIke this:
On error resume next
shCurrentWeek.Range("B4:B" & lr).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
I'm assuming you don't care if it fails, so there's no need to do error trapping. This will keep an error message from displaying if there are no cells returned from your call to SpecialCells.

While Daniel Cook is right, you could use On Error Resume Next, here is another way of going about it, since using On Error Resume Next is really a last resort option in VBA (IMO).
The code below checks for blanks before it tries to use the SpecialCells method.
Option Explicit
Sub DeleteRow()
Dim lr As Long
Dim shCurrentWeek As Worksheet
Set shCurrentWeek = ActiveWorkbook.Sheets("Current Week")
lr = shCurrentWeek.Range("A" & Rows.Count).End(xlUp).Row
If Application.WorksheetFunction.CountBlank(shCurrentWeek.Range("B4:B" & lr)) <> 0 Then
shCurrentWeek.Range("B4:B" & lr).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End If
End Sub

Here is a piece of code I use for that type of operation.
Sub ClearBlank()
Dim i As Long
For i = Range("B65536").End(xlUp).Row To 8 Step -1
If IsEmpty(Cells(i, 4)) Then Rows(i).Delete
Next i
End Sub
I hope this helps!

Not used VBA before today so I'm sure there is a neater way...but this code will delete any row with at least one empty cell. It assumes that you have a header row and that the first column is used for IDs so these cells are not 'looked at'.
The nice thing about this script is that it works for any size of spreadsheet so you don't need to hard-code values each time:
Sub DeleteIncompleteRows()
Dim row As Integer, col As Integer
Dim deleted As Integer
deleted = 0
Dim actualRow As Integer
Dim totalRows As Integer
Dim totalCols As Integer
totalRows = Application.CountA(Range("A:A"))
totalCols = Application.CountA(Range("1:1"))
For row = 2 To totalRows
actualRow = row - deleted
For col = 2 To totalCols
If ActiveSheet.Cells(actualRow, col).Value = "" Then
ActiveSheet.Rows(actualRow).Delete
deleted = deleted + 1
Exit For
End If
Next col
Next row
End Sub
All the best,
Scott

Related

VBA: Copying a range (row-by-row) in a loop and inserting this (row-by-row) in a new sheet (loop + if statement)

In VBA I try to run a loop with an if statement. The loop is set to run a row at a time for a range (wks "Data", B7:J25).
For each row if the value at column C7:C25 is 1, I would like to copy that row (e.g. B7:J7) and insert it at the worksheet "temp" one at a time.
I have tried various codes, for example:
Sub start()
Dim i As Integer
Dim wsData, wsCalcAndOutput, wsTemp As Worksheet
For i = 1 To 25
If Cells((7 + i), 3) = "1" Then
Worksheets("Data").Range("B7:J7").Copy _
Worksheets("temp").Range("B7:J7")
End If
Next
End Sub
But then I can only copy and paste the first row of the range. Alternatively, I found this procedure at stackoverflow, but I can't seem to be able to paste what I copy at each iteration:
Dim wsData, wsCalcAndOutput As Worksheet
Dim rSPX, rSX5E, rNKY, rUKX, rSMI, rEEMUP, testData As Range
Sub start()
Dim i As Integer
For i = 1 To 25
If Cells((7 + i), 3) = "1" Then
With ActiveSheet
.Range(.Cells((7 + i), 2), .Cells((7 + i), 10)).Copy
End With
End If
Next
End Sub
Is this the right way to do so or is there a more efficient way?
Also - in the dataset the criteria for the if statement is actually a string called either "TRUE" or "FALSE". Can an if statement use a string as a signal instead of "1"?
All the best,
Christoffer
As BigBen says, using AutoFilter would be quicker but here is one way of doing this with a loop. Have added a few comments which hopefully explain the basics.
One problem with your code was that you weren't changing the destination cells so they would continually be overwritten.
Sub start()
Dim i As Long 'better than integer
Dim n As Long: n = 7
Dim wsData As Worksheet, wsCalcAndOutput As Worksheet, wsTemp As Worksheet 'specify each type
With Worksheets("Data")
For i = 7 To 25 'change as appropriate
If .Cells(i, 3) = 1 Then 'no need for quotes
Range(.Cells(i, "B"), Cells(i, "J")).Copy _
Worksheets("temp").Cells(n, "B") 'start at row 7?
n = n + 1 'update so that we don't overwrite next time
End If
Next
End With
End Sub

Fill Empty Blank Cells with value within a region horizontaly defined

I'm trying to fill blank cells in a certain region with 0. The reagion should be defined in the current workbook but in sheet2 (not the current sheet). Also the place where it is supposed to fill is between columns
BU:CQ in the current region (not all 100 000 000 lines). Just the number of lines that define the table between columns BU and CQ. I know the problem lies in defining the region... See the code below.
What is missing?
Sub FillEmptyBlankCellWithValue()
Dim cell As Range
Dim InputValue As String
On Error Resume Next
InputValue = "0"
For Each cell In ThisWorkbook.Sheets("Sheet2").Range(BU).CurrentRegion
'.Cells(Rows.Count, 2).End(xlUp).Row
If IsEmpty(cell) Then
cell.Value = InputValue
End If
Next
End Sub
I've this code that i'm positive that works! But i don't wnat selection! I want somthing that specifies the sheet and a fixed range.
Now my idea is to replace "selection" with the desired range. - In this case in particular the range should be 1 - between BU:CQ; 2 - starting at row 2; 3 - working the way down until last row (not empty = end of the table that goes from column A to DE)
Sub FillEmptyBlankCellWithValue()
Dim cell As Range
Dim InputValue As String
On Error Resume Next
For Each cell In Selection
If IsEmpty(cell) Then
cell.Value = "0"
End If
Next
End Sub'
PS: And I also need to specify the sheet, since the button that will execute the code will be in the same workbook but not in the same sheet.
Use SpecialsCells:
On Error Resume Next 'for the case the range would be all filled
With ws
Intersect(.UsedRange, .Range("BU:CQ")).SpecialCells(xlCellTypeBlanks).Value = 0
End With
On Error GoTo 0
MUCH faster than looping !
Try using cells() references, such as:
For i = cells(1,"BU").Column to cells(1,"CQ").Column
cells(1,i).value = "Moo"
Next i
In your current code you list Range(BU) which is not appropriate syntax. Note that Range() can be used for named ranges, e.g., Range("TheseCells"), but the actual cell references are written as Range("A1"), etc. For Cell(), you would use Cells(row,col).
Edit1
With if statement, with second loop:
Dim i as long, j as long, lr as long
lr = cells(rows.count,1).end(xlup).row
For i = 2 to lr 'assumes headers in row 1
For j = cells(1,"BU").Column to cells(1,"CQ").Column
If cells(i,j).value = "" then cells(i,j).value = "Moo"
Next j
Next i
First off, you should reference the worksheet you're working with using:
Set ws = Excel.Application.ThisWorkbook.Worksheets(MyWorksheetName)
Otherwise VBA is going to choose the worksheet for you, and it may or may not be the worksheet you want to work with.
And then use it to specify ranges on specific worksheets such as ws.Range or ws.Cells. This is a much better method for specifying which worksheet you're working on.
Now for your question:
I would reference the range using the following syntax:
Dim MyRange As Range
Set MyRange = ws.Range("BU:CQ")
I would iterate through the range like so:
Edit: I tested this and it works. Obviously you will want to change the range and worksheet reference; I assume you're competent enough to do this yourself. I didn't make a variable for my worksheet because another way to reference a worksheet is to use the worksheet's (Name) property in the property window, which you can set to whatever you want; this is a free, global variable.
Where I defined testWS in the properties window:
Public Sub test()
Dim MyRange As Range
Dim tblHeight As Long
Dim tblLength As Long
Dim offsetLen As Long
Dim i As Long
Dim j As Long
With testWS
'set this this to your "BU:CQ" range
Set MyRange = .Range("P:W")
'set this to "A:BU" to get the offset from A to BU
offsetLen = .Range("A:P").Columns.Count - 1
'set this to your "A" range
tblHeight = .Range("P" & .Rows.Count).End(xlUp).Row
tblLength = MyRange.Columns.Count
End With
'iterate through the number of rows
For i = 1 To tblHeight
'iterate through the number of columns
For j = 1 To tblLength
If IsEmpty(testWS.Cells(i, offsetLen + j).Value) Then
testWS.Cells(i, offsetLen + j).Value = 0
End If
Next
Next
End Sub
Before:
After (I stopped it early, so it didn't go through all the rows in the file):
If there's a better way to do this, then let me know.

If cell is blank delete entire row [duplicate]

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

How to delete the last cell in a column that contains data

This sounds like a very basic question (and it is), but I cannot figure it out and I cannot find a suitable solution on the web.
How do you select the last cell in a column that contains a numeric value and delete it?
I have formulas that go past this cell and return blank values in the column. This is what is tripping me up at the moment. My current code will go all the way down to where I have carried the formulas to and start deleting those cells instead of deleting the last cell with a numeric value.
My current code looks like this
Range("AA1500").End(xlUp).Select
With Selection.Delete
End With
Any help would be greatly appreciated.
Please let me know if I can clarify anything.
Thanks
If you want to go down past cells with arbitrary strings in them and
delete the last numeric value (but not the last cell with a alphanumeric string in it), this should work:
Sub deleteLastNum()
Dim row As Integer
row = Range("A1000").End(xlUp).row
For i = row To 1 Step -1:
If IsNumeric(Cells(i, "A")) Then
Cells(i, "A").Clear
Range("A" & CStr(i + 1), "A" & CStr(row)).Cut Destination:=Range("A" & CStr(i))
Exit For
End If
Next
End Sub
It will also delete the last cell with a formula that evaluates to a number. It moves down the range of cells in the column above it with characters in it to fill in the cleared cell.
What you can do is get the total number of rows of a column (A) then check is last cell value is numeric or not, if numeric then clear that cell.
Sub del()
Dim sh As Worksheet
Dim rn As Range
Set sh = ThisWorkbook.Sheets("Sheet1")
Dim k As Long
Set rn = sh.UsedRange
k = rn.Rows.Count + rn.Row - 1
If IsNumeric(Sheets("Sheet1").Range("A" & k).Value) = True Then
Sheets("Sheet1").Range("A" & k).ClearContents
End If
End Sub
This will check last cell for numeric value in column A.
Hope this is what you are asking.
EDIT
Implementing above for all the sheets in a workbook using a loop is like :
Sub del()
Dim sh As Worksheet
Dim rn As Range
For Each sh In ActiveWorkbook.Worksheets
Set sh = ThisWorkbook.Sheets(sh.Name)
Dim k As Long
Set rn = sh.UsedRange
k = rn.Rows.Count + rn.Row - 1
If IsNumeric(sh.Range("A" & k).Value) = True Then
sh.Range("A" & k).ClearContents
End If
Next sh
End Sub
This will loop through each sheet like Sheet1, Sheet2 or whatever the name of the sheet may be and check for numeric value in last cell of col A, if found numeric then it will delete the value.
You already got an answer to your post, just to be clear, the safest way to find the last row (let's say in Column "AA", according to your post), and ignoring blank cells in the middle, is by using the syntax below:
Sub FindlastRow()
Dim LastRow As Long
With Worksheets("Sheet1") ' <-- change "Sheet1" to your sheet's name
LastRow = .Cells(.Rows.Count, "AA").End(xlUp).Row
' rest of your coding here
End With
End Sub
Screen-shot of the result:
Use 'SpecialCells()'
Sub ClearLastNumber(sh As WorkSheet, columnIndex As String)
On Error GoTo ExitSub 'should 'columnIndex' column of 'sh' worksheet contain no numbers then the subsequent statement would throw an error
With sh.Columns(columnIndex).SpecialCells(xlCellTypeConstants, xlNumbers)
With .Areas(.Areas.Count)
.Cells(.Count).ClearContents
End With
End With
ExitSub:
End Sub
To be used in your "main" sub as follows
Sub Main()
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
ClearLastNumber Sh "A"
Next
End Sub

Conditional Delete in VBA

I am trying to piece together code to make my macro work correctly. This approach has served me well in the past but I cannot seem to adapt any code correctly.
I found the following
Sub way()
Dim Cell As Range
For Each Cell In Range("A1").CurrentRegion
If Len(Cell) < 2 Then Cell.EntireRow.Delete
Next Cell
End Sub
I can adapt the If Len(Cell) criteria to my liking. For example = 10
I do not know how to adapt the code to make it search through all cells in column A and delete the appropriate rows. The code above only does it for A1.
Ideally I would like to delete all rows with cells in column A that have a length of 10 characters. Or alternatively, with a completely different set of code, delete all other rows that do not contain cells in column A that have a length of 10 characters.
When deleting rows it is best to loop backwards:
Sub way()
Dim ws As Worksheet
Dim i As Long
Dim lastrow As Long
Set ws = ActiveSheet
lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
For i = lastrow To 1 Step -1
If Len(ws.Cells(i, 1)) < 2 Then ws.Rows(i).Delete
Next i
End Sub
Essentially, your loop is going through every cell in the Range.CurrentRegion property radiating out from A1. Your narrative expresses that you only want to examine column A but delete the Range.EntireRow property.
The For .. Next loop stepping backwards proposed by Scott Craner is likely your best bet but if you are more comfortable with a For ... Each In loop then yours can be adjusted.
Sub way()
Dim cl As Range, dels As Range
With Worksheets("Sheet1")
For Each cl In .Range("A1").CurrentRegion.Columns(1).Cells
If Len(cl.Value2) = 10 Then
If Not dels Is Nothing Then
Set dels = Union(dels, cl)
Else
Set dels = cl
End If
End If
Next cl
End With
If Not dels Is Nothing Then _
dels.EntireRow.Delete
End Sub
The logic to delete rows that did not have a value in column A that was 10 characters, symbols or digits long would be If Len(cl.Value2) <> 10 Then.
I haven't checked for syntax, but something like this should work:
dim idx as integer
idx = 1
while Range("A" + cstr(idx)).value <> ""
'insert your delete logic here...
idx = idx + 1
wend