Conditional Delete in VBA - 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

Related

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.

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

Move the row to another sheet

I have a worksheet, that I need to move the row, if the value on the last column is equal to false.
I don't know how to move to sheet 2 and make go through entire sheet.
Thank for the help.
Sub DeleteMatches2()
Dim a As Range, b As Range
Dim c As String
'The column that has the value is V2
With Sheets("Controle Estoque Fixo")
Set a = .Range(.Cells(2, "V"), .Cells(Rows.Count, "V").End(xlUp))
End With
For Each b In a
If b.Value = "False" Then
Sheets("Sheet1").Select
'know I am lost
End If
Next
End Sub
There are many ways to do this, the simplest is to keep a row counter, which tracks how many rows you've used on on the other sheet. Increment this counter by one each time. Lets assume you have column headers on sheet1, so the first available row is row 2:
Sub DeleteMatches2()
Dim a As Range, b As Range
Dim c As String
Dim rowCounter As Long
rowCounter = 2 ' start at row 2
'The column that has the value is V2
With Sheets("Controle Estoque Fixo")
Set a = .Range(.Cells(2, "V"), .Cells(Rows.Count, "V").End(xlUp))
End With
For Each b In a
If b.Value = "False" Then
'Sheets("Sheet1").Select ' you don't need to select an object to access it, so remove this
'here's the bit you need
Sheets("Controle Estoque Fixo").Rows(b.row).Cut Sheets("Sheet1").Rows(rowCounter) ' this cuts and pastes all in one line
' you use the row counter to specify the destination
rowCounter = rowCounter + 1 ' the next time you'll paste on the next row
End If
Next
End Sub
As people have commented there are many many many ways to do this so have a good look on Stack Overflow, something else might appeal to you.

VBA slow process for removing rows based on condition

I have a VBA Excel code with that checks values in a specific column. If the row in that column contains the value 'Delete' and then deletes the row.
The code works well, but it is really slow. Any ideas on how to get the code run faster?
Dim rng1 As Range
Dim i As Integer, counter As Integer
'Set the range to evaluate to rng.
Set rng1 = Range("g1:g1000")
'initialize i to 1
i = 1
'Loop for a count of 1 to the number of rows
'in the range that you want to evaluate.
For counter = 1 To rng1.Rows.Count
'If cell i in the range1 contains an "Delete"
'delete the row.
'Else increment i
If rng1.Cells(i) = "Delete" Then
rng1.Cells(i).EntireRow.Delete
Else
i = i + 1
End If
Next
Thanks
c.
Sub deletingroutine()
Dim r As Range
For Each r In Range("g1:g1000")
If r = "delete" Then r.EntireRow.Delete
Next r
End Sub
I managed to find a solution with the Autofilter function.
Hope it helps someone
Selection.AutoFilter
Set ws = ActiveWorkbook.Sheets("UploadSummary")
lastRow = ws.Range("G" & ws.Rows.Count).End(xlUp).Row
Set rng = ws.Range("G1:G" & lastRow)
' filter and delete all but header row
With rng
.AutoFilter Field:=7, Criteria1:="delete" ' 7 refers to the 7th column
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
Try sorting the rows (on collumn G) then deleting all marked ("delete") rows in one action. That is much faster.

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

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