how can this filter be done in a macro?

[Guest]

I have a table of between 50,000 and 60,000 records from which I have to
extract several hundred records. The following function, filled down a
helper column, is one way of filtering these records (via the Auto-Filter
tool):

=IF(AND(ISNUMBER(MATCH(LEFT(B6,3),Sheet1!$A$2:$A$11,0)),ISNUMBER(MATCH(C6,Sheet1!$B$2:$B$39))),"X","")

B6 is an account number, whose three left digits signify what type of
account it is. A2:A11 in Sheet1 is the list of those three left digits I
want to extract. C6 is an expense code; B2:B39 in Sheet1 is a list of those
expense codes I want to extract. One would run the AutoFilter on the "X"
values returned by the above formula.

However, what I would like to do is have a macro which runs the same logic,
copies the filtered records, and pastes them in a new sheet. Then all I have
to do is attach that macro to a button.

How to do this?

Thanks for any insight.

Dave

 

[Bernie Deitrick]

Dave,

This macro assumes that B6 and C6 are the cells to reference BEFORE inserting a new column A:

Sub DaveFilterMacro()
Dim mySht As Worksheet
Dim myNSht As Worksheet
Set mySht = ActiveSheet
Set myNSht = Sheets.Add(Type:="Worksheet")
With mySht
.Range("A5").EntireColumn.Insert
.Range("A5").Value = "Helper"
.Range("A6:A" & .Cells(Rows.Count, 2).End(xlUp).Row).FormulaR1C1 = _
"=IF(AND(ISNUMBER(MATCH(LEFT(RC[2],3),Sheet1!R2C1:R11C1,0))," & _
"ISNUMBER(MATCH(RC[3],Sheet1!R2C2:R39C2))),""X"","""")"
.Range("A5").AutoFilter Field:=1, Criteria1:="X"
.Range("A5").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
myNSht.Range("A1")
End With
End Sub

HTH,
Bernie
MS Excel MVP

 

[Guest]

Dave,

Try this.

Tables on Sheet1, Data on Sheet2 and Filtered data on Sheet3.

Option Explicit
Sub FilterData()

Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet

Dim acc_rng As Range, exp_rng As Range
Dim c As Range
Dim lastrow As Long
Dim irow As Long
Dim orow As Long

Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set ws3 = Worksheets("Sheet3")


With ws1
Set acc_rng = .Cells(2, "A").Resize(10, 1)
Set exp_rng = .Cells(2, "B").Resize(38, 1)
End With

orow = 1
With ws2

lastrow = .Cells(Rows.Count, "B").End(xlUp).Row

For irow = 2 To lastrow '<== change starting row

If Application.And(Not (IsError(Application.Match(.Cells(irow, "B"),
acc_rng, 0))), _
Not (IsError(Application.Match(.Cells(irow, "C"), exp_rng, 0))))
Then
orow = orow + 1
.Cells(irow, "A").EntireRow.Copy ws3.Cells(orow, 1)
End If
Next irow
End With

End Sub

 

[Guest]

Correction ....

If Application.And(Not (IsError(Application.Match(Left(.Cells(irow, "B"),
3), acc_rng, 0))), _
Not (IsError(Application.Match(.Cells(irow, "C"), exp_rng, 0))))
Then

 

[Lori]

You could try entering the AND(...) part of your formula as a
calculated criteria to the right of your data, in Z6 say.

Then on a new sheet choose Advanced Filter with list range List!
a5:y65536, criteria List!z5:z6 and Copy to a1 on the new sheet.

This should also be recordable as a macro.

 

[Dave Peterson]

So your real data starts in Row 6?

I used column X to hold the formula--you didn't share what column you used:

Option Explicit
Sub testme()
Dim RptWks As Worksheet
Dim CurWks As Worksheet
Dim LastRow As Long

Set CurWks = Worksheets("sheet2") '????????
Set RptWks = Worksheets.Add

With CurWks
.AutoFilterMode = False
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
With .Range("x6:x" & LastRow)
.Formula _
= "=IF(AND(ISNUMBER(MATCH(LEFT(B6,3),Sheet1!$A$2:$A$11,0))," _
& "ISNUMBER(MATCH(C6,Sheet1!$B$2:$B$39))),""X"","""")"
.Value = .Value 'makes the filter faster
End With
.Range("x6:X" & LastRow).AutoFilter field:=1, Criteria1:="x"
.AutoFilter.Range.EntireRow.Copy _
Destination:=RptWks.Range("a1")
End With

End Sub

If you used a different column you'll have a few spots to fix. And if your data
starts in a different row, you'll want to change the formula, too.

Use the number of the first row getting the formula.

 

[Guest]

Yeah the data starts in row 6. It's a feed from a database and for some
reason the feed is set up so that the table starts in row 6. Thanks.

Dave
--
A hint to posters: Specific, detailed questions are more likely to be
answered than questions that provide no detail about your problem.

So your real data starts in Row 6?

I used column X to hold the formula--you didn't share what column you used:

Option Explicit
Sub testme()
Dim RptWks As Worksheet
Dim CurWks As Worksheet
Dim LastRow As Long

Set CurWks = Worksheets("sheet2") '????????
Set RptWks = Worksheets.Add

With CurWks
.AutoFilterMode = False
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
With .Range("x6:x" & LastRow)
.Formula _
= "=IF(AND(ISNUMBER(MATCH(LEFT(B6,3),Sheet1!$A$2:$A$11,0))," _
& "ISNUMBER(MATCH(C6,Sheet1!$B$2:$B$39))),""X"","""")"
.Value = .Value 'makes the filter faster
End With
.Range("x6:X" & LastRow).AutoFilter field:=1, Criteria1:="x"
.AutoFilter.Range.EntireRow.Copy _
Destination:=RptWks.Range("a1")
End With

End Sub

If you used a different column you'll have a few spots to fix. And if your data
starts in a different row, you'll want to change the formula, too.

Use the number of the first row getting the formula.

 

[Guest]

That's an interesting suggestion, thanks. I was hoping to avoid the macro
recorded and learn some VBA code with this exercise, but this method is
definitely easier.

Dave
--
A hint to posters: Specific, detailed questions are more likely to be
answered than questions that provide no detail about your problem.

You could try entering the AND(...) part of your formula as a
calculated criteria to the right of your data, in Z6 say.

Then on a new sheet choose Advanced Filter with list range List!
a5:y65536, criteria List!z5:z6 and Copy to a1 on the new sheet.

This should also be recordable as a macro.

 

[Lori]

Well you can learn how to do Advanced Filters with VBA by examining
the code Then make any edits to the code you need. Using built-in
functionality is generally desirable where possible for speed and
maintenance.