VBA for filtering columns
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.
Ampi Severe
Updated on August 31, 2020Comments
-
Ampi Severe over 3 years
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