I have a large table from which I want to delete entire rows corresponding to specific value of column A. I use for loop but I am looking for a more efficient way.
Sub deleteRow()
For i = 1 To 900000
If Cells(i, 1) > 7 Then
Rows(i).Select
Selection.Delete
End If
Next i
End Sub
This simple Macro will work for you:
No Need for Loop
For a Table use this:
Sub deleteRow()
With ActiveSheet.ListObjects("Table1") ' Change table name
.Range.AutoFilter Field:=1, Criteria1:=">7"
.DataBodyRange.Delete
End With
End Sub
It will also show a warning, select Yes when it appears
For Simple Range Object Use this:
Sub deleteRow()
With ActiveSheet.UsedRange
.AutoFilter Field:=1, Criteria1:=">7"
.Offset(1, 0).SpecialCells(xlCellTypeVisible).Delete xlShiftUp
End With
End Sub
Useful Link with Various of Table Operation Commands. Here
You should delete them all at once at the end rather than on each instance.
Try this.
Sub deleteRow()
Dim killRNG As Range
Set killRNG = Cells(Rows.Count, 1).EntireRow
For i = 1 To 900000
If Cells(i, 1) > 7 Then
Set killRNG = Union(Cells(i, 1).EntireRow, killRNG)
End If
Next i
killRNG.Delete
End Sub
Some Tips:
Option Explicit
Sub deleteRow()
Dim i As Long, LastRow As Long
'Create a with statement refer to the sheet where data are store
With ThisWorkbook.Worksheets("Sheet1")
'Find LastRow of column A. There is no need to loop up to 900000
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'When you loop aiming to delete you loop from bottom to top
For i = LastRow To 1 Step -1
'In both ".Cells(i, 1) > 7" & ".Rows(i).EntireRow.Delete" we use "." before
If .Cells(i, 1).Value > 7 Then
.Rows(i).EntireRow.Delete
End If
Next i
End With
End Sub
Related
in the range A1 to A70, if a cell is empty/blank then delete that entire row and move the other rows underneath up
Thank you
Use following codes.
Sub RemoveDuplicate()
On Error Resume Next
Range("A1:A70").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Edit:
Sub RemoveBlankRowsInARange()
Dim rng As Range, rws As Long, i As Long
Dim LastRow As Long
' LastRow = Cells(Rows.Count, "A").End(xlUp).Row
' Set rng = ActiveSheet.Range("A2:A" & LastRow)
' rws = rng.Rows.Count
'
' For i = rws To 1 Step (-1)
For i = 100 To 1 Step (-1)
If WorksheetFunction.CountA(Rows(i)) = 0 Then Rows(i).EntireRow.Delete
Next
End Sub
#Harun24HR - Here's how I attempted at solving this problem: I recorded a macro that deletes a row and I edited that macro to do my original question, why doesn't this work, please correct it:
Sub DeleteRowWithEmptyCell()
Dim row As Integer
For row = 1 To 100 'or whatever numbers needed
If Cells(row, 1).Value() = "" Then
Rows("row:row").Select
Selection.Delete Shift:=xlUp
End If
Next row
End Sub
I have the sheet like this:
Picture given
All I want to is that, I can move down the next row and show its value.
I already have the code:
Sub test()
'Select the first row.
MsgBox Sheet1.AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Cells(1, 3).Value
'Then move down to the second row of filtered data.
'Code
End Sub
Can someone suggest how to finish my sub above?
I would appreciate your help.
You could try implement/adapt the following:
Sub VisRows()
Dim rng As Range, lr As Long
With Sheet1 'Change accordingly
lr = .Cells(.Rows.Count, "B").End(xlUp).Row
Set rng = .Range("B2:B" & lr)
'Apply your filter
For Each cl In rng.SpecialCells(xlCellTypeVisible)
Debug.Print cl.Value
Next cl
End With
End Sub
I have sheet1 with every other cell on column "B" has the following letteres, "LLC". My vba script should clear all "LLC" and horizontally delete entire ROW.
The code I have already used:
Sub deleteRowswithSelectedText()
For Each CELL In Selection
If CELL.Value(i, 2) = "LLC" Then
Rows(CELL.Row).ClearContents
End If
Next
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
End Sub
Try this, If you want to loop through each cell and test it you can, but you will need to loop from the bottom to the top. Another way is to use a filter and delete all the visible rows at the same time.
Dim lr As Long
Dim i As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = lr - 1 To 2 Step -1
If Cells(i, "B") = "LLC" Then
Cells(i, "B").EntireRow.Delete
End If
Next i
Another way is to use a filter and delete every row that has "LLC" in column B
With ActiveSheet
.AutoFilterMode = False
With Range("A1").CurrentRegion
.AutoFilter Field:=2, Criteria1:="LLC"
On Error Resume Next
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
.AutoFilterMode = False
End With
These are just examples, there are many way to accomplish this task.
The code below is probable closer to what you were trying to do.
With Sheets("Sheet1") 'Change to your worksheet name
For Each CELL In .Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
If CELL.Value = "LLC" Then
CELL.EntireRow.Delete
End If
Next CELL
End With
So I've been searching hard to find why my code hasn't been working, but every time I try, I get a result where nothing is changed. Can someone please tell me what I'm missing? Sorry, I'm a total novice but I'm trying.
Dim Cell As Range
With Sheets(1)
' loop column D until last cell with value (not entire column)
For Each Cell In .Range("D2:D" & .Cells(.Rows.Count, "D").End(xlUp).Row)
If Cell.Value <> 110 Then
Rows(Cell.Row).EntireRow.Delete
End If
Next Cell
End With
Instead of looping, make use of excels inbuilt functions, its cleaner and more concise.
With Sheets(1).UsedRange
.AutoFilter Field:=4, Criteria1:="<>110"
.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.AutoFilter
End With
if you insist on looping then use the following code:
With Sheets(1).UsedRange
For lrow = .Rows.Count To 2 Step -1
If .Cells(lrow, 4).Value <> 110 Then .Rows(lrow).Delete
Next lrow
End With
Untested, but maybe something like:
Option explicit
Sub DeleteRows()
With thisworkbook.worksheets(1)
' loop column D until last cell with value (not entire column)
Dim lastRow as long
lastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
Dim rowIndex as long
For rowIndex = lastRow to 2 step -1
If .cells(rowIndex, "D").value2 <> 110 then
.cells(rowIndex, "D").entirerow.delete
End if
Next rowIndex
End With
End sub
If you have a lot of rows, you could use union to build a range consisting of all rows to be deleted, then delete them in one go.
*EDIT
Here is what ended up kind of working. The solutions below do not run the AddProj when new row is inserted.
Sub Worksheet_Calculate()
Dim X As Range
Set X = LastCell 'The X is superflous, you could just use the LastCell variable
If Sheet5.Range("A" & Rows.Count).Value < X.Value Then
X.Value = Me.Range("A" & Rows.Count).Value
AddProj
End If
End Sub
Module 1 contains the following:
Function LastCell() As Range
With Sheet5
Set LastCell = .Cells(Rows.Count, 1).End(xlUp)
End With
End Function
Sub AddProj()
Sheet1.Range("Master").Copy Sheet1.Range("C" & Rows.Count).End(xlUp).Offset(1)
End Sub
I am trying to read the data in the last cell of a column.
The value of "X" should be the value of this last cell.
I then want "X" to be compared to the number of rows and if the number of rows is less than "X", perform my macro "AddProj".
Once "X" and Column A are the same value, nothing else is to be done.
For some reason, it is not working.
This code is on the worksheet where I want the comparison to be made.
Please see my code below:
Private Sub Worksheet_Calculate()
X = LastCell
If Sheet5.Range("A" & Rows.Count).Value < Sheet5.Range("X").Value Then
Sheet5.Range("X").Value = Me.Range("A" & Rows.Count).Value
AddProj
End If
End Sub
Sub LastCell()
Range("A1").End(xlDown).Select
End Sub
The "AddProj" is a module that is referenced in the code above (thank you #jsheeran #SJR ACyril for help):
Sub AddProj()
Sheet1.Range("Master").Copy Sheet1.Range("C" & Rows.Count).End(xlUp).Offset(1)
End Sub
Thanks in advance.
Try this:
Sub Worksheet_Calculate()
Dim lRow As Long
lRow = Sheet5.Cells(Sheet5.Rows.Count, 1).End(xlUp).Row
If Sheet5.Cells(lRow, 1) > lRow Then
Sheet5.Cells(lRow, 1) = lRow
AddProj
End If
End Sub
X is a variable but you refer to it as "X". Also avoid using .Select as it is not necessary and even in this case just does nothing, because first of all a Sub cannot return a value and second .Select has also no return value. The best way to calculate the last row is this: Sheet5.Cells(Sheet5.Rows.Count, 1).End(xlUp).Row
Here is just a slight variation on UPGs great answer.
Dim lRow As Long
lRow = Sheet1.Cells(Sheet1.Rows.Count, 1).End(xlUp).Row
If lRow >= Sheet1.Cells(lRow, 1) Then
Exit Sub
Else: AddProj
End If