I'm struggling with the following: I want to delete rows for which date (column C) is prior than today. My code should work (according to the web) but it doesn't and moreover, it's super slow.. Here is a part of it:
For i = 2 To LastRow
If Cells(i, "C").Value < Date Then Rows(i).EntireRow.Delete
Next i
Instead of putting "C", I could put 3, but doesn't change anything. I've tried to add the End If (before the next i), but not necessary apparently. Maybe the Date is not the right format..
What's wrong with this code ?
Great thanks for your help :)
Use the auto-filter capabilities of Excel in your favor. Filter the range by your criteria to delete the matching rows:
With Range("C1:C" & lastrow)
.AutoFilter 1, "<" & CLng(Date)
.Offset(1).EntireRow.Delete
.AutoFilter
End With
You will want to step backwards when deleting rows and verify that it is actually a date in the cell. To see what it's doing, set a breakpoint on the first line and use F8 to step through it. Also verify the value of LastRow is getting set to the correct value.
For i = LastRow To 2 Step -1
If IsDate(Cells(i, "C").Value) then
If Cells(i, "C").Value < Date Then Rows(i).EntireRow.Delete
End If
Next i
Related
I initially asked a question below.
Basically I want VBA to look at Column L:L. If the cell=program, and the cell below does not equal lathe I want the row above to be deleted. If the cell doesn't equal program continue looking until the end of the data.
Realized I needed to look at the data different, as I was losing rows that I needed to stay.
New logic, which I think will still use some of the old program, but
it needed to be sorted using another column. I need the VBA to look at
column E:E. If the cell in the row below is a duplicate of the cell
above, then look at column L in that row to see if the cell says
Program. If so the cell below should be Lathe. If not lathe delete the
Program Row, If it is Lathe leave both rows. If the Cells in Column E
are not duplicates, continue looking. EX. If E5=E6, If not continue
looking. If yes Look at L5 to see if it say Program. If so look at L6
for Lathe. If not delete ROW5.
This I what I received that answered teh first question which I think will still get used
Dim rngCheck as Range
Dim rngCell as Range
Set rngCheck = Range("L1", "L" & Rows.Count - 1)
For each rngCell in rngCheck
If rngCell.value = "Program" And rngCell.offset(1,0).value <> "lathe" then
rngCell.offset(-1,0).EntireRow.Delete
End if
Next rngCell
This should do it
For i = ThisWorksheet.Cells.SpecialCells(xlCellTypeLastCell).Row to 2 step -1
' that row do you mean the duplicate or the original (I am using original)
If ThisWorksheet.Cells(i, 5) = ThisWorksheet.Cells(i-1, 5) and _
ThisWorksheet.Cells(i-1, 12) = "Program" and ThisWorksheet.Cells(i, 12) <> "Lathe"
ThisWorksheet.Rows(i-1).EntireRow.Delete
End If
Next i
When deleting it is best to iterate from last to first. If prevent you from skipping rows.
Sub RemoveRows()
Dim x As Long
With Worksheets("Sheet1")
For x = .Range("E" & .Rows.Count).End(xlUp).Row To 2 Step -1
If .Cells(x, "E").Value = .Cells(x - 1, "E").Value And Cells(x - 1, "L").Value = "Program" Then
.Rows(x).Delete
End If
Next
End With
End Sub
I'm writing a code that copies data from one sheet into another and I've got that function working fine. Now, I'm trying to code it to delete any rows that contain duplicate information based off that information's ID number in column F. Part of our process is to manually enter in column E when each row has been worked.
So my end goal is for the code to delete rows where column E is blank and column F is a duplicate. My code runs, but doesn't delete anything. I'm really hoping I'm just missing something ridiculously obvious.
For i = 1 To Range("f" & Rows.Count).End(xlUp).Row
If Cells(i, 5).Value = "" Then 'if column E is blank on row i
x = Cells(i, 6).Value
If Not IsError(Application.Match(x, "F:F", 0)) Then '& if that row is a duplicate
ActiveSheet.Range(x).EntireRow.Delete 'delete new duplicate row
End If
End If
Next i
Try it with,
For i = Range("f" & Rows.Count).End(xlUp).Row to 1 Step -1
If Cells(i, 5).Value = "" Then 'if column E is blank on row i
x = Cells(i, 6).Value
If Application.Countif(Columns(6), x) > 1 Then '& if that row is a duplicate
Rows(i).EntireRow.Delete 'delete new duplicate row
End If
End If
Next i
You were trying to delete the row number x, not i. Additionally, everything was going to be matched once.
So there are a couple of errors that need to be addressed in your code. First, if you are looping over a range and deleting rows, it's best to start from the bottom and work your way up. This prevents issues where your iterator is on a row, that row gets deleted, and the loop essentially skips the next row.
Next, you are looking for a Match in column F of x, which contains a value from Column F. So, it will always return a value (itself, at the very minimum). Maybe try using a COUNTIF and seeing if it's greater than 1 may be a better option?
Next, you populated the variable x with the value in Cells(i, 6), but then you try to use it as a range when deleting. Change your code to the following and see if it works:
For i = Range("f" & Rows.Count).End(xlUp).Row To 1 Step -1
If Cells(i, 5).Value = "" Then 'if column E is blank on row i
x = Cells(i, 6).Value
If Application.Countif(Columns(6), x) > 1 Then '& if that row is a duplicate
ActiveSheet.Rows(i).Delete 'delete new duplicate row
End If
End If
Next i
Why not use the .RemoveDuplicates method? It's faster than looping around. Here's a rough outline on its use:
With Range
.RemoveDuplicates Columns:=Array(6), Header:=xlYes
End With
Here's the msdn doc for the method, and another page with a more detailed implementation. They should clear up any questions you might have.
is it possible to filter the working table on two criteria that are wildcards.
I want to delete all rows from my date that have Ident number in column C not starting with 1 or 4. After filtering and deleting I want to show all data again and have no blank rows in between
Is that even possible? I was trying a lot of stuff. I am posting 2 options that I thought were most likely to work - but didnt. Any info is greatly appreciated.
With ActiveSheet
'FIRST TRY
.AutoFilter Field:=3, Criteria1:="<>1*", Operator:=xlOr, Criteria2:="<>4*"
'SECOND TRY
.AutoFilter Field:=3, Criteria1:=Array( _
"<>1*", "<>4*"), Operator:=xlFilterValues
'THEN I WANT ALL ROWS THAT DONT START WITH 1 OR 6 DELETED
.Offset(1).SpecialCells(xlVisible).EntireRow.Delete
End With
As mentioned by Tim Williams in the comment, you can't apply a text filter to a numeric column. I personally wouldn't use a filter for this in either case, as there's a dead simple VBA only approach:
Dim current As Long
Dim sheet As Worksheet
Dim start As String
Set sheet = ActiveSheet
With sheet
For current = .UsedRange.Rows.Count To 2 Step -1
start = Left$(.Cells(current, 3), 1)
If start <> "1" And start <> "4" Then
.Rows(current).Delete
End If
Next
End With
EDIT: If the sheet is sorted, the row deletions are a lot faster, because you can track the start and end of ranges that need to be deleted instead of removing potentially thousands of individual rows:
Dim current As Long
Dim sheet As Worksheet
Dim start As String
Dim bottom As Long
With sheet
For current = .UsedRange.Rows.Count To 2 Step -1
start = Left$(.Cells(current, 3), 1)
If start <> "1" And start <> "4" And bottom = 0 Then
bottom = current
ElseIf (start = "1" Or start = "4") And bottom <> 0 Then
.Range((current + 1) & ":" & bottom).Delete
bottom = 0
End If
Next
End With
Try it as two separate filters. I have not testing this code, but am wondering if it will maintain the first filter and add the second filter.
'Filter 1
.AutoFilter Field:=3, Criteria1:="<>1*", Operator:=xlFilterValues
'Filter 2
.AutoFilter Field:=3, Criteria2:="<>4*", Operator:=xlFilterValues
This worked for me:
ActiveSheet.Range("$A$1").CurrentRegion.AutoFilter Field:=3, _
Criteria1:="<>1*", Operator:=xlAnd, Criteria2:="<>4*"
Col C must be formatted as "Text" - you may have to re-enter the information to be sure (you should see the grren "number stored as text" indicator on those cells)
Really hope someone out there can help me. So i have the following code. The independent codes work fine by themself, but when executing the script, it only loops through the first condition. What i want it to do is to loop through all the code, each time. I think it's a small thing I am missing, but i can't seem to find a solution.
Sub Copypre()
Dim i As Integer
Dim n As Integer
For i = 2 To 10
'Checks the number of entries in the "Pre" table, to make sure that there are no spaces between the lines
On Error Resume Next
n = Worksheets("Pre").Range("A2:A6000").Cells.SpecialCells(xlCellTypeConstants).Count
If n = Null Then
n = i
'Goes through the different sheets to find all "pre" values and paste them in the "Pre" sheet
If ThisWorkbook.Sheets("273").Range("A" & i).Value = "Pre" Then
Range(Cells(i, 1), Cells(i, 3)).Select
Selection.Copy
Sheets("Pre").Select
Range("A" & n).Select
ActiveSheet.Paste
Sheets("2736").Select
End If
End If
Next i
End Sub
There are a couple of issues with your code, but the main issue may be that If n = Null will never be true since an integer cannot be Null. You could change this to If n = 0.
A couple of things to consider:
Error handling: Always go back to normal error handling with On Error GoTo 0 as soon as possible. This way you would have known (assuming that there is no sheet "2736" in your workbook) that your code is trying to select a sheet that does not exist.
Range argument: Be carefull when not specifying the sheet when using the Range (and Cells) argument. When you switch back and fourth between different sheets that you select, there is a change that you may loose track of what sheet the Range is returning data from. Consider declaring each worksheet and then copy your ranges like:
Dim w273 As Worksheet
Set w273 = ThisWorkbook.Sheets("273")
w273.Range(w273.Cells(i, 1), w273.Cells(i, 3)).Copy
Loops can quickly consume time with long columns of data and I suspect that your code was heavily redacted. Try this alternate method of block copying across to the destination worksheet.
Sub Copypre()
With Sheets("273").Cells(1, 1).CurrentRegion
.AutoFilter
.Columns(1).AutoFilter field:=1, Criteria1:="=Pre"
If CBool(Application.Subtotal(103, .Offset(1, 0))) Then
.Offset(1, 0).Resize(, 3).Copy _
Destination:=Sheets("Pre").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End If
.AutoFilter
End With
End Sub
All that can get accomplished without a single variable declaration.
Addendum:
As to your original question, the whole if "pre"/copy/paste section is nested within the if n = Null so it can only be reached if n = Null is true. If there are no .SpecialCells(xlCellTypeConstants)to count, n will be assigned its default value (e.g. 0). Zero is not equal to Null so that condition is never met. To check your code, add the following line.
On Error Resume Next
n = Worksheets("Pre").Range("A2:A6000").Cells.SpecialCells(xlCellTypeConstants).Count
Debug.Print "n is " & n
After running it, open the Immediate window with Ctrl+G. If there are no non-formula values in Pre!A2:A6000 you should see n is 0.
Thanks allot for all the advices. The null trick worked! I am totally new to VBA so it's nice to get some tips and tricks from experts. I will try to make the code more simple as Jeeped mentioned, as this is not very elegant. In regards to the sheets, i can totally understand the confusion, i have fixed that also. It works now and looks like this:
Sub Copypre()
Dim i As Integer
Dim n As Integer
For i = 2 To 5000
' Checks the number of entries in the "Pre" table, to make sure that there are no spaces between the lines
On Error Resume Next
n = Worksheets("Pre").Range("A2:A6000").Cells.SpecialCells(xlCellTypeConstants).Count
' Goes through the different sheets to find all pre values and paste them in the "Pre" sheet
If ThisWorkbook.Sheets("2736").Range("A" & i).Value = "Pre" Then
Sheets("2736").Select
Sheets("2736").Range(Cells(i, 1), Cells(i, 3)).Select
Selection.Copy
Sheets("Pre").Select
Range("A" & (n + 2)).Select
ActiveSheet.Paste
Sheets("2736").Select
Sheets("2736").Select
Range(Cells(i, 5), Cells(i, 6)).Select
Selection.Copy
Sheets("Pre").Select
Range("E" & (n + 2)).Select
ActiveSheet.Paste
Sheets("2736").Select
End If
Next i
End Sub
Summary: I'm taking a row of data from one sheet and pasting it into another, however the sheet would be a daily use kind of thing where new data is just entered below old data.
Problem: On each new run, 7 is consistently added to the UsedRange.Count. For example: on one run the UsedRange.Count will be 7; the next time I run through the function the count will be 14.
What I'm Looking For: Why is this the case and is there a way to help UsedRange be more accurate
-I've included the entire Function for references' sake.
Function eftGrabber()
Dim usedRows As Integer
Dim i As Integer
ChDir "\\..."
Workbooks.Open Filename:= _
"\\...\eftGrabber.xlsm"
usedRows = Sheets("EFT").UsedRange.Count
Windows("Data").Activate
Sheets("DataSheet").Range("A11").EntireRow.Copy
Windows("eftGrabber").Activate
Sheets("EFT").Range("A" & usedRows + 1).Select
ActiveSheet.Paste
i = usedRows
Do 'THIS LOOP DELETES BLANKS AFTER POSTING NEW LINES
Range("A" & i).Select
If Range("A" & i) = "" Then
ActiveCell.EntireRow.Delete
End If
i = i - 1
Loop Until i = 1
Windows("eftGrabber").Activate
ActiveWorkbook.Save
Windows("eftGrabber").Close
End Function
Let me know if I've left out any important details. Thanks in advance!
Change: usedRows = Sheets("EFT").UsedRange.Count
To: usedRows = Sheets("EFT").Range("A" & Sheets("EFT").Rows.Count).End(xlUp).Row
Where "A" can be changed to whichever row you wish to count the total number of columns.
There is a danger in using UsedRange because it factors in such things and formatted cells with no data and other things that can give you unexpected results, like if you are expecting your data to start in Range("A1"), but it really starts in another range!
I will say, however, that If you really wish to use UsedRange, your code above is still wrong to get the rows. Use this instead UsedRange.Rows.Count or to get the last absolute cell of the UsedRange, use UsedRange.SpecialCells(xlCellTypeLastCell).Row
This two line do the magic
usedCol = ThisWorkbook.ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Column
usedRow = ThisWorkbook.ActiveSheet.UsedRange.SpecialCells(xlCellTypeLastCell).Row
For more info visit Microsoft's site
http://msdn.microsoft.com/en-us/library/office/ff196157.aspx
Thanks for the discussion...
.UsedRange.Rows.Count and .UsedRange.Columns.Count work fine provided there is something in cell A1. Otherwise need to use the SpecialCells solution.
Hope this is helpful.
“UsedRange” works if you use it like this >>
x := Sheet.UsedRange.Row + Sheet.UsedRange.Rows.Count - 1;
y := Sheet.UsedRange.Column + Sheet.UsedRange.Columns.Count - 1;
Problem with SpecialCells is that you can't use it on a Protected Sheet.
Assuming you have contiguous sheet (i.e. no blank cells), and you sheet starts in A1, then I have found that
Range("A1").CurrentRegion.Rows.Count
gives the most reliable results.