what i am trying to do.
I have two worksheets "dashboard" and "temp calc".I am trying to delete rows based on two different conditions in each worksheet.
Dashboard- delete rows if column number 15 <> active
delete rows if column number 10 <> E&D,ESG,PLM SER,VPD,PLM Prod.
Temp calc = Delete rows if column number 6 is blank
delete rows if column number 3n1
where n1 and n2 are dates taken from range("n1" and "n2") in dashboard.
What I have tried.
using a for loop
using a filter
arrays(I am unable to actually do this using an array
My Problem
these methods are very slow and my data is around 1,68,000(grows on a weekly basis).So I am looking for alternatives to what I have tried. Basically something which will do this fast.
my codes I have tried.
the below code works but it takes upto 6-10 minutes depending on the data
Worksheets("Dashboard").Activate
Range("A4").Select
lastrow = Cells(Rows.Count, 1).End(xlUp).Row
For x = lastrow To 4 Step -1
If Cells(x, 15).Value <> "Active" Or (Cells(x, 10).Value <> "E&D" And Cells(x, 10).Value <> "ESG" _
And Cells(x, 10).Value <> "PLM SER" And Cells(x, 10).Value <> "VPD" And Cells(x, 10).Value <> "PLM PROD") Then
Rows(x).Delete
End If
Next x
The below code uses the autofilter method.the problem is that data which is not in my compare range is left after filtering(i.e if my n1 =1st Jan and n2=30th jan 2013. the filter will still leave behind data that is not in the n1 and n2 range.
Set ws = ThisWorkbook.Worksheets("Temp Calc")
'~~> Start Date and End Date
Sheets("Dashboard").Select
N1 = Range("n1").Value
N2 = Range("n2").Value
Sheets("Temp Calc").Select
With ws
'~~> Remove any filters
.AutoFilterMode = False
'~~> Get the last row
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
'~~> Identify your data range
Set FltrRng = .Range("A1:F" & lRow)
'~~> Filter the data as per your criteria
With FltrRng
'~~> First filter on blanks
.AutoFilter Field:=6, Criteria1:="="
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'~~> Delete the filtered blank rows
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
ws.ShowAllData
'~~> Next filter on Start Date
.AutoFilter Field:=3, Criteria1:="<" & N1, Operator:=xlAnd
'~~> Finally filter on End Date
.AutoFilter Field:=4, Criteria1:=">" & N2, Operator:=xlAnd
'~~> Filter on col 6 for CNF
'.AutoFilter Field:=6, Criteria1:="CNF"
'~~> Delete the filtered rows
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
'~~> Remove any filters
.AutoFilterMode = False
End With
Apologies in case the question is not adequate.
Any alternatives which will speed up what I am trying to do is highly appreciated.
Auto filter is fast - definitely the way to go - but it hides data rows and doesn't delete them. Since your code turns the filter off at the end, the hidden rows come back. Instead, you should apply the filter, select all, copy, paste into new sheet, and delete the old sheet. This will be very fast - and do exactly what you are asking for.
Apologies that I am not posting working code - typing on ipad...
Try below code
Sub DeleteRows()
Dim x As Long
Dim Rng As Range
Dim lastRow As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Sheets("Dashboard")
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set Rng = .Range("A1:A" & lastRow)
For x = Rng.Rows.Count To 1 Step -1
If .Cells(x, 15).Value <> "Active" Or (.Cells(x, 10).Value <> "E&D" And .Cells(x, 10).Value <> "ESG" _
And .Cells(x, 10).Value <> "PLM SER" And .Cells(x, 10).Value <> "VPD" And .Cells(x, 10).Value <> "PLM PROD") Then
Rng.Rows(x).Delete
End If
Next
End With
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Related
Good morning,
currently I have this code to delete rows without due date (Column J) and amount paid=0 (Column H).
Sub delete_rows()
Range("A1").End(xlDown).Select
Sheets("AA").Select
Range("J2").Select
ActiveCell.FormulaR1C1 = "=IF(RC[-5]=0,"""",RC[-5])"
Range("J2").Select
Selection.AutoFill Destination:=Range("J2:J500"), Type:=xlFillDefault
Range("J2").End(xlDown).Select
Range("K2").Select
Application.ScreenUpdating = False
With Sheet2
For line = .Cells(.Rows.Count, "J").End(xlUp).Row To 2 Step -1
If .Cells(line, "J") = "" Then
.Rows(line).Delete
End If
Next linha
End With
Application.ScreenUpdating = True
ActiveCell.FormulaR1C1 = "=IF(RC[-4]="""","""",RC[-4])"
Range("K2").Select
Selection.AutoFill Destination:=Range("K2:K500"), Type:=xlFillDefault
Range("K2").End(xlDown).Select
Range("J1").Select
Application.ScreenUpdating = False
With Sheet2
For line = .Cells(.Rows.Count, "K").End(xlUp).Row To 2 Step -1
If .Cells(line, "K") = "" Then
.Rows(line).Delete
End If
Next line
End With
Application.ScreenUpdating = True
End sub()
I created a code with a defined number of lines...however it takes a long time for the code to run, because sometimes the number of lines is small and it always runs the 500 lines. What's the way to set the code so that it looks for the last filled row in column A, and then eliminate the rows where column H has values =0 and in column J no values?
Please check: find last cell. Also have a look at: avoid select.
Afterwards, I think you should be able to understand the following code, which should get you the required result:
Sub test()
Application.ScreenUpdating = False
'declare your variables
Dim ws As Worksheet
Dim Rng1 As Range, Rng2 As Range
Dim i As Long, lastRow As Long
Set ws = Sheets("AA")
With ws
'get last row in
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
'set ranges for loop
Set Rng1 = Range(.Cells(2, "H"), .Cells(lastRow, "H"))
Set Rng2 = Range(.Cells(2, "J"), .Cells(lastRow, "J"))
'reverse loop
For i = Rng1.Rows.Count To 1 Step -1
'check conditions for cell in "H" and "J"
If Rng1.Cells(i) = 0 And Rng2.Cells(i) = "" Then
'defined ranges start at row 2, hence +1
ws.Rows(i + 1).Delete
End If
Next i
End With
Application.ScreenUpdating = True
End Sub
Public Sub MainTOfomat()
Dim ShippingQty As Range
Dim ReceivedQty As Range
ActiveSheet.Columns("A:P").AutoFit
ActiveSheet.Range("A:P").AutoFilter Field:=13, Criteria1:="No"
ActiveSheet.Range("K:L").AutoFilter Field:=2, Criteria1:="<>"
Set ShippingQty = Range("K2")
Set ReceivedQty = ShippingQty.Offset(0, 1)
ShippingQty.Select
Do Until IsEmpty(ActiveCell)
If ShippingQty.Value = 0 Then
ShippingQty.Offset(0, 5) = "Needs Fulfillment"
ElseIf ShippingQty.Value > ReceivedQty.Value Then
ShippingQty.Offset(0, 5) = "Needs Receipt"
End If
ActiveCell.Offset(1, 0).Select
Loop
End Sub
The code is program is supposed to loop though each row in the column and fill in the statement based on the result of the condition for values in two other columns. The problem is that the loop goes through, but only the first line actually changes, and the auto filter code before the loop gets skipped.
Here is your macro fixed up.
As mentioned before your ShippingQty range and ReceivedQty do not change with the activecell. When moving to the next cell, that is the activecell. The filter range need to be the same. A:P is filtered, when changing to K:L ,field 2 actually becomes column B, so if you want to filter out non-blanks in column L you need the field 12.
Sub YourMacro()
Dim ShippingQty As Range
Dim ReceivedQty As Range
ActiveSheet.Columns("A:P").AutoFit
With ActiveSheet.Range("A:P")
.AutoFilter Field:=13, Criteria1:="No"
.AutoFilter Field:=12, Criteria1:="<>"
End With
Set ShippingQty = Range("K2")
Set ReceivedQty = ShippingQty.Offset(0, 1)
ShippingQty.Select
Do Until IsEmpty(ActiveCell)
If ActiveCell.Rows.Hidden = False Then
If ActiveCell.Value = 0 Then
ActiveCell.Offset(0, 5) = "Needs Fulfillment"
ElseIf ActiveCell.Value > ActiveCell.Offset(, 1).Value Then
ActiveCell.Offset(0, 5) = "Needs Receipt"
End If
End If
ActiveCell.Offset(1, 0).Select
Loop
ActiveSheet.AutoFilterMode = 0
End Sub
You can use this option as well without using selects.
Sub Option1()
Dim rng As Range, c As Range
Dim ws As Worksheet
Set ws = ActiveSheet
Application.ScreenUpdating = 0
With ws
Set rng = .Range("K2:K" & .Cells(.Rows.Count, "K").End(xlUp).Row)
With .Range("A:P")
.AutoFilter Field:=13, Criteria1:="No"
.AutoFilter Field:=12, Criteria1:="<>"
End With
For Each c In rng.SpecialCells(xlCellTypeVisible)
If c = 0 Then c.Offset(, 5) = "Needs Fulfillments"
If c > c.Offset(, 1) Then c.Offset(, 5) = "Needs Receipts"
Next c
.AutoFilterMode = False
End With
End Sub
my goal is to delete rows with column 3 with the cell value that has inventory (>0) and column 4 that has the cell value TRUE in the current sheet. I tried to use the code to this website and I'm pretty sure I did something wrong where it says ActiveSheet.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
Public Sub FilterStock()
ActiveSheet.Range("A1").AutoFilter Field:=4, Criteria1:="TRUE"
ActiveSheet.Range("A1").AutoFilter Field:=3, Criteria1:=">0"
Application.DisplayAlerts = False
ActiveSheet.DataBodyRange.SpecialCells(xlCellTypeVisible).Delete
Application.DisplayAlerts = True
ActiveSheet.AutoFilter.ShowAllData
End Sub
This code worked for me:
Sub DeletelRows()
Dim lastRow As Long
Dim debug1 As Variant
Dim debug2 As Variant
'Find the last non-blank cell in column C
lastRow = Cells(Rows.Count, 3).End(xlUp).Row
For x = lastRow To 2 Step -1 'Start at bottom and go up to avoid complications when the row is deleted.
debug1 = Cells(x, 3).Value 'You can set breakpoints to see what the values are.
debug2 = Cells(x, 4).Value
If (Cells(x, 3).Value > 0 And UCase(Cells(x, 4).Value) = "TRUE") Then
Rows(x).Delete
End If
Next x
End Sub
I'm creating a tool that needs to delete rows that in the column "E" have dates older than 01-01-2019.
Sub OlderDateDelete()
Dim i As Variant
Application.DisplayAlerts = False
For i = Sheets("Iberica Not Sent").Count To 2 Step -1
If Sheets(i).Range("E2").Value < DateValue("01/01/2019") Then
Sheets(i).Delete
End If
Next i
Application.DisplayAlerts = True
End Sub
Watch this lines:
If Sheets(i).Range("E2").Value < DateValue("01/01/2019") Then
Sheets(i).Delete
End If
Those lines will delete your sheet.
I think you should edit it instead as:
If Rows(i).Range("E2").Value < DateValue("01/01/2019") Then
Rows(i).Delete
End If
The easiest I come up with is to put the date "01/01/2019" in a cell, in my example in "G1"
Then convert each range to this cell and delete them:
Sub DeletePreviousYears()
Dim i As Long
Dim LastRow As Long
LastRow = Sheets("Iberica Not Sent").Range("E" & Rows.Count).End(xlUp).Row
Application.DisplayAlerts = False
For i = LastRow To 2 Step -1
If Range("E" & i) <> "" And Range("E" & i).Value < Range("G1").Value Then
Rows(i).Delete
End If
Next i
Application.DisplayAlerts = True
End Sub
The best would also be to use a Function to find the Last Row and come back up with your loop.
Also with your first code using Sheets, you were looping through sheets and not row.
This is to answer your written question. You can use an Autofilter then delete all the visible data except the header row.
With Sheets("Iberica Not Sent")
.AutoFilterMode = False
With Range("A1").CurrentRegion
.AutoFilter Field:=5, Criteria1:="<01/01/2019"
On Error Resume Next
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
.AutoFilterMode = False
End With
Or, you can loop like this
Dim lr As Long
Dim i As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
For i = lr To 2 Step -1
If Cells(i, "E") < DateValue("01/15/2019") Then
Cells(i, "E").EntireRow.Delete
End If
Next i
I prefer to use a filter.
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