Do Loop + Match - vba

I am looking to delete everything that does not match my inputbox value. However, it seems like the loop I am using is not working at all! It seems the code does not read the loop. The loop should delete the entire row of each cell in the column E that does not match my inputbox variable. I run the code, insert the value in the input box and nothing gets deleted.
Can someone PLEASE help me??
'Get the Tenrox code to be deleted
tenroxcode = InputBox("Insert the Tenrox Code that you want to keep")
'Find and delete all unnecessary tenrox codes
r = Application.Match(tenroxcode, Columns("E"), 0)
Do While IsError(r)
Rows(r).EntireRow.Delete
r = Application.Match(tenroxcode, Columns("E"), 0)
Loop

Try this:
tenroxcode = InputBox("Insert the Tenrox Code that you want to keep")
With Worksheets("Sheet1") ' change as needed
With .UsedRange.Columns(5) 'assumes data is in column a1 and contiguous across cells
If Not .Find(tenroxcode, lookat:=xlWhole) is Nothing Then
.AutoFilter 1, "<>" & tenroxcode
.offset(1).specialcells(xlCellTypeVisible).entirerow.delete 'offset so header row stays
End If
End With
.AutoFilterMode = False
End With

A simple way to do this is to use the Autofilter to filter on anything that doesn't match your condition, and then delete the rows. And I'd suggest turning your data into an Excel Table first, because it simplifies code.
Simply fire up the macro recorder, and you'll get code like this::
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:= _
"<>SomeValue", Operator:=xlAnd
Range("Table1[Column1]").Select
Selection.EntireRow.Delete
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1
That should be enough to get you started.

Related

Excel VB Advanced Filter Copy with Condition

I am trying to put a condition on each row copied. I want all uniques but only if they also have a specific value in another field.
This is what I have to grab all uniques (and it works) but I can't figure out how to get only the rows with a specific value in column J.
r1.Columns(20).AdvancedFilter xlFilterCopy, , Sheet11.Range("A1"), unique:=True
I have tried doing a CriteriaRange but I can't seem to get the syntax correct for it. Additionally I thought about an If statement but logically in my head it means it would fire off the whole list every time it has a true statement, not on a per row basis.
Here is how I thought it might work. But I get a type mismatch error.
r1.Columns(20).AdvancedFilter xlFilterCopy, r1.Columns(10).Value = "November", Sheet11.Range("A1"), unique:=True
Thoughts?
First of all, your Criteria Range should be just that - a Range with the header corresponding to the column to be filtered, and criteria underneath. For example, D1:D2 in this snapshot:
Secondly, you won't be able to copy just a single column (20) while filtering another column (10) in the same step.
You can tweak the Advanced Filter to
First filter the entire list in place based on the criterion provided
And then copy the visible cells in the column in question
Something like this (change Sheet and Range references as needed):
Sub MyFilter()
Dim lastRow As Long
With Sheet1
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A1:B" & lastRow).AdvancedFilter _
Action:=xlFilterInPlace, CriteriaRange:=.Range("D1:D2"), Unique:=True
With .Range("B1:B" & lastRow).SpecialCells(xlCellTypeVisible)
.Copy Sheet2.Range("A1")
End With
.ShowAllData
End With
End Sub
To be able to keep the other parts of the code that worked perfectly. I added a hidden sheet and wrote a macro to copy the filtered results out to the new hidden sheet. Then I ran my original code against the filtered data on that hidden sheet.
Sub FilterLiveToDataSheet()
' Unhide Required Sheets
Sheets("Original-Data").Visible = True
Sheets("Filtered-Data").Visible = True
' Delete Old Data
Sheets("Filtered-Data").Select
Cells.Select
Selection.ClearContents
' Copy Filtered Data
Sheets("Original-Data").Select
Range("TBL_ATTR_Spend[[#Headers],[HeaderName]]").Select
Selection.AutoFilter
ActiveSheet.ListObjects("TBL_ATTR_Spend").Range.AutoFilter Field:=10, _
Criteria1:="Delta"
Cells.Select
Selection.Copy
' Paste to Data Sheet
Sheets("Filtered-Data").Select
Cells.Select
ActiveSheet.Paste
' Unfilter Original Data Page
Sheets("Original-Data").Select
Range("TBL_ATTR_Spend[[#Headers],[HeaderName]]").Select
Selection.AutoFilter
' Hide Required Sheets
Sheets("Original-Data").Visible = False
Sheets("Filtered-Data").Visible = False
' Go to Results Sheet
Sheets("Results").Select

Autofilter does not filter anything when Criteria is not met

I have a segment of VBA that looks to autofilter out all the rows in which column 37 is blank. It works great, EXCEPT when there is nothing in the column for the entire data set. Then, instead of filtering away everything but the header row, autofilter does not filter any rows out. This results in the adding of the comment "Expected Waste to all the rows instead of just the ones with a value in column 37. Code is below. Any help on what I am doing wrong would be much appreciated.
' Filter Data by ExpectedWaste
Sheets("Data").Columns("A:AQ").AutoFilter Field:=37, Criteria1:="<>"
' Add expected Waste comment
Sheets("Data").Range("AQ2:AQ" & lastRow).FormulaR1C1 = "Expected waste"
' Unfilter Data
If (Sheets("Data").AutoFilterMode And Sheets("Data").FilterMode) Or
Sheets("Data").FilterMode Then
Sheets("Data").ShowAllData
End If
Typically, I test for visible cells before performing any actions.
with Sheets("Data").Cells("A1:AQ" & lastRow)
.AutoFilter Field:=37, Criteria1:="<>"
with .resize(.rows.count-1, .columns.count).offset(1, 0)
if cbool(application.subtotal(103, .cells)) then
'perform actions on .Specialcells(xlcelltypevisible) here
.columns("AQ").Specialcells(xlcelltypevisible).value = "Expected waste"
end if
end with
end with
I don't think AutoFilter works with blank columns. Check if there is anything to be filtered first, something along the line of Cells(Rows.Count, 37).End(xlUp).Row > 1 because otherwise the code you have wrote Sheets("Data").Range("AQ2:AQ" & lastRow).FormulaR1C1 = "Expected waste" fills the whole column.

sub will not loop through second if statement vba

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

Application.WorksheetFunction.Sum is not working on filtered results VBA

I'm trying to use WorksheetFunction.Sum to sum the same field on all rows in the result, however, it doesn't seem to be doing it. It doesn't throw an error, it just doesn't sums anything. I know for a fact some rows should throw more than 1 row result.
This is what I'm trying to do:
For Each Code In BomCodes
With InventorySheet
.AutoFilterMode = False
.Range("B1").AutoFilter Field:=2, Criteria1:="Project"
.Range("D1").AutoFilter Field:=4, Criteria1:="ContractNumber"
.Range("N1").AutoFilter Field:=14, Criteria1:="Code"
.Range("Q1").AutoFilter Field:=17, Criteria1:=">0"
End With
'Do a search through the filtered inventory
Set rangeFilteredInventory = InventorySheet.Range("Q2:Q" & Cells(Rows.Count, "Q").End(xlUp).Row)
'Get the sum of all results
With InventorySheet
TotalQty = WorksheetFunction.Sum(rangeFilteredInventory.SpecialCells(xlCellTypeVisible))
If TotalQty <> 0 Then
Debug.Print TotalQty, vbNewLine, vbNewLine
End If
End With
Next Code
I've tried without using With InventorySheet, using the whole
Applicaiton.WorksheetFunction.Sum,
Set rangeFilteredInventory = InventorySheet.Range("Q2:Q" & Cells(Rows.Count, "Q").End(xlUp).Row)
Loops through all BUT If I comment the If structure, it always show 0.
Changing for
Set rangeFilteredInventory = InventorySheet.Range("Q2:Q" & Rows.Count).End(xlUp).Row
It doesn't access even the first record
And also
Set rangeFilteredInventory = InventorySheet.Range("Q" & Rows.Count).End(xlUp).Row
It doesn't access the first record either.
So, my idea is that I'm taking the range wrong. It should sum up all the "Q's" in that sheet.
If i make a macro on that sheet that does
With Worksheets("sbom")
.AutoFilterMode = False
.Range("B1").AutoFilter Field:=2, Criteria1:="5522970"
.Range("D1").AutoFilter Field:=4, Criteria1:="0008621302140U"
.Range("N1").AutoFilter Field:=14, Criteria1:="LVE70001372"
.Range("Q1").AutoFilter Field:=17, Criteria1:=">0"
End With
It returns multiple records.
I'm sorry if I'm new anything in there in the wrong way, I'm new to VBA and i'm learning on my own.
EDIT:
I switched SUM for Subtotal and although it does the loop, TotalQty is still 0. I used part of the answer BK201 gave me to improve some things.
For Each Code In BomCodes
Debug.Print "Grabbed Code:", Code, vbNewLine
With InventorySheet
.AutoFilterMode = False
LRowOnQ = .Columns("Q").End(xlUp).Row
.Range("B1").AutoFilter Field:=2, Criteria1:="Project"
.Range("D1").AutoFilter Field:=4, Criteria1:="ContractNumber"
.Range("N1").AutoFilter Field:=14, Criteria1:="Code"
.Range("Q1").AutoFilter Field:=17, Criteria1:=">0"
Set rangeFilteredInventory = .Range("Q2:Q" & LRowOnQ)
End With
'Do a search through the filtered inventory
'Get the sum of all results
' With InventorySheet
TotalQty = WorksheetFunction.Subtotal(9, rangeFilteredInventory.SpecialCells(xlCellTypeVisible))
If TotalQty <> 0 Then
Debug.Print TotalQty, vbNewLine, vbNewLine
End If
Next Code
When working with finding last rows, always apply the logic of With. Basically, be mindful of which row in which sheet you want to find. Be more explicit. I think that part of the error rises from simple bad coding style, not bad code, as the approach is sound though the results are not there.
In the interest of better coding, and maybe a solution, please see the following code and the comments after.
For Each Code In BomCodes
With InventorySheet
.AutoFilterMode = False
LRowOnQ = .Columns("Q").End(xlUp).Row
.Range("B1").AutoFilter Field:=2, Criteria1:="Project"
.Range("D1").AutoFilter Field:=4, Criteria1:="ContractNumber"
.Range("N1").AutoFilter Field:=14, Criteria1:="Code"
.Range("Q1").AutoFilter Field:=17, Criteria1:=">0"
Set rangeFilteredInventory = .Range("Q2:Q" & LRowOnQ)
End With
'Get the sum of all results
TotalQty =WorksheetFunction.Sum(rangeFilteredInventory.SpecialCells(xlCellTypeVisible))
If TotalQty <> 0 Then
Debug.Print TotalQty, vbNewLine, vbNewLine
End If
Next Code
Two things:
First, notice the variable LRowOnQ. The difference from the your code is that you used Cells(Rows.Count... without a clear specification of where it's supposed to be taken. Just because InventorySheet precedes it doesn't mean the variable will be taken from there. If your macro is being called from another sheet and the last row is taken from the active sheet, it will return a wrong value.
The proper way to deal with this is, as seen above, to lock it to InventorySheet, column Q. That way, the value will not come from a vague source. This also promotes better coding style, as Setting rangeFilteredInventory now is reduced to more readable code.
Also, notice the placement. It was set before the AutoFilter is applied. The reason is quite simple: placing it after the filter is applied will check the last row of the filtered column and not the last row of the data table. Test code is provided for reference.
Sub Test()
Dim Rng As Range
Set Rng = ActiveSheet.Columns("Q")
Debug.Print Rng.Cells(Rows.Count, 1).End(xlUp).Row
End Sub
There are many reasons why returning the last row of a filtered table is more troublesome than the whole unfiltered table, but I won't get into that here. However, if the reverse is what you want, just place it after all the AutoFilters are applied.
Second, notice how I removed the secondary With InventorySheet. I see in your code that you had to declare With InventorySheet twice, but the second block has no use for it at all. Since rangeFilteredInventory has been declared already, there's no need to include it in a With block.
Now, even with the coding style fixed, your approach can use some work. I, for one, second the use of SUBTOTAL instead of SUM. However, I won't assume that this is what's necessary, as the case may be different for you or perhaps you want to use this for some other reason instead.
Please test the above and let us know of the results.

Excel VBA Conditional Filter

simple VBA question. I need a VBA subroutine that will filter my data based on a condition (in this case, if what's in column C equals 11-Jun-12 [41071 in numeric form]) without looping through the whole data set. I've looked a bit at filtering on the Internet but nothing seems to be quite what I want (or I just don't really understand what's going on). To be clear, here's an example of what I want:
I want http://imgur.com/qebVv
to go to http://imgur.com/zDncq.
Thanks!
Assuming that the spreadsheet is set up as it appears in your screenshot here is what you can do
Sub DateFilter()
'hide dialogs
Application.ScreenUpdating = False
'filter for records that have June 11, 2012 in column 3
ActiveSheet.Cells.AutoFilter Field:=3, Criteria1:="6/11/2012"
'deletes all matching rows
ActiveSheet.AutoFilter.Range.Delete
Application.ScreenUpdating = True
End Sub
Jack Radcliffe,
Do you mean a simple autofilter, for example:
Sub SimpleColumnDateFilter1()
' Quick Recorded Macro
' Select a Column
' Activate Autofilter
' For a range C1 through the rest of C
' Autofilter such that the column will display dates not equal to 11/15/2012
Columns("C:C").Select
Selection.AutoFilter
ActiveSheet.Range("C:C").AutoFilter Field:=1, Criteria1:= _
"<>11/15/2012", Operator:=xlAnd
End Sub