VBA for filtering columns - excel

I have a big database-like sheet, first row contains headers. I would like a subset of rows of this table based on column values. Two issues:
1) VBA-wise I would like to loop through the columns, when the values for all necessary columns all match, copy the entire row into a new sheet.
2) The subset of rows is based on a list. I just read I can use Autofilter with an array. Is it possible to input this array from a column instead of manually entering it in the VBA code? The list I'm using consists of 200 different strings and will be updated periodically.
Where CritList is the list of strings. I still need to figure out how, but now I leave the office, so more tomorrow.
EDIT1 Thanks to #DougGlancy; the autofiltering works now. Here is his beautiful code (I only added the array-filter).
EDIT2 Included a more elaborate array-filter, where NameList is the list I would like to filter for. Now it all works!
Sub FilterAndCopy()
Dim LastRow As Long
Dim vName As Variant
Dim rngName As Range
Set rngName = Sheets("Sheet3").Range("NameList")
vName = rngName.Value
Sheets("Sheet2").UsedRange.Offset(0).ClearContents
With Worksheets("Sheet1")
.Range("A:E").AutoFilter
'Array filter from NameList
.Range("A:J").AutoFilter Field:=3, Criteria1:=Application.Transpose(vName), _
Operator:=xlFilterValues
.Range("A:E").AutoFilter field:=2, Criteria1:="=String1" _
, Operator:=xlOr, Criteria2:="=string2"
.Range("A:E").AutoFilter field:=3, Criteria1:=">0", _
.Range("A:E").AutoFilter field:=5, Criteria1:="Number"
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A1:A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
Destination:=Sheets("Sheet2").Range("A1")
End With
End Sub

Here's a different approach. The heart of it was created by turning on the Macro Recorder and filtering the columns per your specifications. Then there's a bit of code to copy the results. It will run faster than looping through each row and column:
Sub FilterAndCopy()
Dim LastRow As Long
Sheets("Sheet2").UsedRange.Offset(0).ClearContents
With Worksheets("Sheet1")
.Range("$A:$E").AutoFilter
.Range("$A:$E").AutoFilter field:=1, Criteria1:="#N/A"
.Range("$A:$E").AutoFilter field:=2, Criteria1:="=String1", Operator:=xlOr, Criteria2:="=string2"
.Range("$A:$E").AutoFilter field:=3, Criteria1:=">0"
.Range("$A:$E").AutoFilter field:=5, Criteria1:="Number"
LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
.Range("A1:A" & LastRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
Destination:=Sheets("Sheet2").Range("A1")
End With
End Sub
As a side note, your code has more loops and counter variables than necessary. You wouldn't need to loop through the columns, just through the rows. You'd then check the various cells of interest in that row, much like you did.

Related

AutoFilter Criteria Range Not taking an Array

1. I have data in one sheet and want to filter the list of criteria in another column
2. I want to have the criteria in separate WS as well
I have included 2 separate codes below
code for same sheet list Array
Sub FilterTeams()
Dim LastRow As Long
LastRow = Range("A" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("A1:H" & LastRow).AutoFilter Field:=3, Criteria1:="=*" & Range("Q1") & "*"
End Sub
list array in other sheet
code details
Sub Filter()
Dim Criteria As Variant
Criteria = Worksheets("Sheet1").Range("A1:A140")
Worksheets("AP").Range("$A$1:$h$100").AutoFilter Field:=3, Criteria1:=Criteria, Operator:=xlFilterValues
End Sub
it is filtering only the first value and not all values in the column
(it should filter all values contains)
Problem:
You are defining your array from a Range, that gives you a 2D array, which you cannot pass into Autofilter Easily. So we have to change it into 1D Array.
Solution: Change your second code to this:
Sub Filter()
Dim Criteria As Variant
Dim cri() As String
Criteria = Worksheets("Sheet1").Range("A1:A140")
ReDim Preserve cri(UBound(Criteria))
For I = LBound(Criteria) To UBound(Criteria)
cri(I) = Criteria(I, 1)
Next
Worksheets("AP").Range("$A$1:$h$100").AutoFilter Field:=1, Criteria1:=cri, Operator:=xlFilterValues
End Sub
Alternative: The code that you are using is Fixed Code. There is one Dynamic code that could be also of use for you. Check this Answer.

Range Column and add Value to the specific range

I have Excel file that I want to filter about one column and on another column add specific value
Sub Macro1()
'
' Macro1
'
'
Range("Table1[type phone]").Select
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:= _
"=*samsung*", Operator:=xlAnd
Range("Table1[company]").Select
'Here I want to add the specific value "Samsung"'
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:= _
"=*iphone*", Operator:=xlAnd
Range("Table1[company]").Select
'Here I want to add the specific value "Apple"'
End Sub
Also how can I filter about one column Blanks cells and on another column add specific value "other"?
[
What conditions can be written if, for example, the Samsung Devices table is missing?
Because if I run the code it crashes in the line it is looking for Samsung.
How can I do it?
Thank You for helping!
To change the value of only cells that are visible (aka those that are show in the filter) you can use SpecialCells(xlCellTypeVisible)
So for your example the code that would go in the first break would be
"Range("B2:B18").SpecialCells(xlCellTypeVisible).Value= "Samsung"
and the second break
"Range("B2:B18").SpecialCells(xlCellTypeVisible).Value= "Apple"
You need to change "18" to whatever the last row is. (Or you can define a variable called LastRow and then call that instead of hard-coding the number which means it will dynamically change based on how many rows there are.)
With LastRow
Sub Macro1()
Dim LastRow As Long
LastRow = ActiveSheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
Range("Table1[type phone]").Select
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:= _
"=*samsung*", Operator:=xlAnd
Range("Table1[company]").Select
Range("B2:B" & LastRow).SpecialCells(xlCellTypeVisible).Value= "Samsung"
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:= _
"=*iphone*", Operator:=xlAnd
Range("Table1[company]").Select
Range("B2:B" & LastRow).SpecialCells(xlCellTypeVisible).Value= "Apple"
End Sub
We created a new variable called LastRow and defined it as long (A type of number). Then we defined LastRow according to a formula I use from this site:
https://www.thespreadsheetguru.com/blog/2014/7/7/5-different-ways-to-find-the-last-row-or-last-column-using-vba
Finally we replace Range("B2:B18") with Range("B2:B" & LastRow) which dynamically replaces the 18 with the number LastRow.

How to copy/paste rows based on matching criterias in 2 columns?

I'm using the alteration of the code from Scott Craner (which works perfectly). However, now I would like VBA to match criteria not only from one column but from 2 columns and then copy/paste as formulas to the next sheet.
Sub TransferRows()
Dim lLRow As Long
With Sheets("Sheet1")
lLRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("B:B").AutoFilter Field:=1, Criteria1:="Cat"
.Range("B2:B" & lLRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy
Sheets("Sheet2").Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlFormulas
.AutoFilterMode = False
End With
End Sub
Criteria1 in column "B" is "Cat", I need to add another Criteria2 ("dog") from column "C". So whenever I have "Cat" in "B" and "Dog" in "C" the entire rows are copied to Sheet2. PS. Bear in mind that I have various types of data in columns "B" and "C" so filters are imperative (also since there are 10's of thousands of rows I can't use the loop as it takes too long). Thus I would welcome advice on how to add another criteria to the aforementioned code.
Thanks
West
Try the code below (see comments inside the code):
Option Explicit
Sub TransferRows()
Dim lLRow As Long
With Sheets("Sheet1")
lLRow = .Cells(.Rows.Count, 1).End(xlUp).Row
With .Range("B1:C" & lLRow)
.AutoFilter Field:=1, Criteria1:="Cat"
.AutoFilter Field:=2, Criteria1:="dog"
End With
.Range("B2:C" & lLRow).SpecialCells(xlCellTypeVisible).EntireRow.Copy
' rest of your code goes here
End With
End Sub

Remove row based on cell value

The code is designed to remove the column headers (after importing several files) for the data. But I get error: "1004" Which is "Application-defined or object-defined error". I've referenced different solutions on SO but to no avail.
Before I run this code snippit I remove the blank rows and have included this to show what does work as well and might even hold the key.
'Remove all rows with blanks first
Set wb = Workbooks(ThisWorkbook.Name)
'Remove blank rows based on if column 'B' is blank as a and B are filled when there is risk key showing
wb.Worksheets("BatchData").Activate
Columns("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'Now to delete based on column headers!
Dim LastRow As Long
LastRow = Cells(Rows.Count, 1).End(xlUp).Row
'Filter Column A and delete selection
'############# Error line below
ActiveSheet.Range("A1:" & A & ":" & LastRow).AutoFilter Field:=2, Criteria1:= _
"=Item", Operator:=xlOr, Criteria2:="="
Selection.EntireRow.Delete
EDIT:
Amended code, some tweaks as per comments and also I had field "2" referenced and was trying to use 'A' which is 1.
Dim LastRow As Long
LastRow = wb.Worksheets("BatchData").Cells(Rows.Count, 1).End(xlUp).Row
'Filter Column A and delete selection
ActiveSheet.Range("A1:A" & LastRow).AutoFilter Field:=1, Criteria1:= _
"=Item", Operator:=xlOr, Criteria2:="="
ActiveSheet.Range("$A$1:$A$" & LastRow).Offset(0, 0).SpecialCells _
(xlCellTypeVisible).EntireRow.Delete
Last line edit based on; VBA: How to delete filtered rows in Excel? but offset changed from 1,0 to 0,0
Trying to clean-up your code a little, and to eliminate possible errors, try the code below, it filters Column A for "Item", then you can use one of 2 options:
Option 1: delete all rows, including header row.
Option 2: delete all rows, except header row.
Option Explicit
Sub DeleteFilteredRows()
Dim LastRow As Long
With ThisWorkbook.Worksheets("BatchData")
' remove blank rows based on if column 'B' is blank as a and B are filled when there is risk key
.Columns("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
' find last row in Column !
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
' Filter Column A
.Range("A1:A" & LastRow).AutoFilter Field:=1, Criteria1:= _
"=Item", Operator:=xlOr, Criteria2:="="
' option 1: delete also header row
.Range("A1:A" & LastRow).SpecialCells _
(xlCellTypeVisible).EntireRow.Delete
' option 2: if you want to keep the header row
.Range("A1:A" & LastRow).Offset(1, 0).SpecialCells _
(xlCellTypeVisible).EntireRow.Delete
End With
End Sub

VBA Compile Error: Expected Named Parameter

I am new to VBA's and have pieced together this macro from various searches on "how to filter between two specific dates in excel." I am trying to have it read the dates from two cells and restrict the shown data to data between those dates. The input data to the workbook is a SQL table that will be growing over time, so I need the left bound of the range to be the last row with a value in it. Each line in my AutoFilter part returns an "Expected Named Parameter" error with the := sign highlighted. From the forums I have read this is due to using VBA reserved words as variable names, but I not think that is the case in this instance.
Here is my code:
Public Sub MyFilter()
.AutoFilterMode = False
Dim datRight, datLeft As Date
Dim lastRow As Long
datLeft = Range("J1").Value
datRight = Range("J2").Value
lastRow = Range("A:A").Find("*", Range("A2"), searchdirection:=xlPrevious).Row
ActiveSheet.Range("F2:F" & lastRow).AutoFilter Field:=7,
Criteria1:=">=" & datLeft, _
Operator:= xlAnd,
Criteria2:="<=" & datRight, VisibleDropDown:=True
End Sub
The first error you will get is at the line .AutoFilterMode = False Notice the DOT before Autofilter. You have to qualify it with the relevant sheet. For example, ThisWorkbook.Sheets("Sheet1").AutoFilterMode = False
When you are trying to find the lastrow using *, Always use the method as mentioned in THIS post else you will get an error if the worksheet is blank.
Your declaration Dim datRight, datLeft As Date. In VBA only the last variable will be declared as Date and the first one will be declared as Variant. Change it to Dim datRight As Date, datLeft As Date Also if the J1 and J2 values are not date values then you will get an error.
Now to your problem. You are getting that error because you the missing the continuation character _
Try this
ActiveSheet.Range("F2:F" & lastRow).AutoFilter Field:=7, _
Criteria1:=">=" & datLeft, _
Operator:=xlAnd, _
Criteria2:="<=" & datRight, VisibleDropDown:=True

Resources