Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

VBA for filtering columns

Tags:

foreach

excel

vba

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
like image 350
Ampi Severe Avatar asked Dec 05 '22 13:12

Ampi Severe


1 Answers

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.

like image 104
Doug Glancy Avatar answered Dec 24 '22 23:12

Doug Glancy