Conditional Autofilter

[uberathlete]

Hi folks. I need some help. Basically, I would like to autofilter based on values in another column, copy the filtered data then paste in a new worksheet. For example (please see image):

I would like to filter based on columns F and G. So for F2 and G2 with the date 1/2/00 and symbol A, I would like to filter by 1/2/00, then filter by A. Then I would like the filtered data to be copied and pasted in a new worksheet.

This repeats for the rest of columns F and G. So for F3 and G3 with date 1/6/00 and symbol A, filter by 1/6/00 then filter by A. Then copy andpaste filtered data in a new worksheet. So on and so forth.

I believe this requires code. I really really need help on this so any suggestions would be great. Thanks!

 

[BrianB]

The trouble is we cannot use the standard Data/Filter/Advanced filter because this will only copy to the current sheet.

'==============================================================================
'- COPY DATA FROM LIST TO A NEW WORKSHEET ACCORDING TO CRITERIA SET
'- ref http://www.mrexcel.com/board2/viewtopic.php?t=283442&highlight=
'- Brian Baulsom July 2007
'==============================================================================
Sub DATA_EXTRACT()
    Dim FromSheet As Worksheet  ' data sheet (uses ActiveSheet)
    Dim FromRow As Long         ' data row
    Dim LastRow As Long         ' last data row
    Dim ToSheet As Worksheet    ' makes new sheet
    Dim ToRow As Long           ' new sheet row
    Dim CriteriaRow As Long     ' to get criteria from columns F & G
    Dim MyDate As Date          ' criterion 1
    Dim MySymbol As String      ' criterion 2
    '------------------------------------------------------------------------
    Application.Calculation = xlCalculationManual
    Set FromSheet = ActiveSheet      'data sheet
    FromRow = 2
    LastRow = FromSheet.Range("A65536").End(xlUp).Row
    CriteriaRow = 2
    '------------------------------------------------------------------------
    '- loop through criteria
    While FromSheet.Cells(CriteriaRow, "F") <> ""
        '---------------------------------------------------------------------
        '- get criteria
        MyDate = FromSheet.Cells(CriteriaRow, "F").Value
        MySymbol = FromSheet.Cells(CriteriaRow, "G").Value
        '---------------------------------------------------------------------
        '- results : make new sheet
        s = ActiveWorkbook.Sheets.Count
        Set ToSheet = Worksheets.Add(after:=ActiveWorkbook.Worksheets(s))
        ToSheet.Name = Format(MyDate, "dd-mm-yy") & " " & MySymbol
        ToSheet.Range("A1:D1").Value = FromSheet.Range("A1:D1").Value
        ToRow = 2
        '---------------------------------------------------------------------
        '- datasheet : loop data
        For FromRow = 2 To LastRow
            '- check for data match (*** NB. CASE SENSITIVE ***)
            If FromSheet.Cells(FromRow, "A").Value = MyDate _
                And FromSheet.Cells(FromRow, "B").Value = MySymbol Then
                '- transfer data
                ToSheet.Range("A" & ToRow & ":D" & ToRow).Value = _
                    FromSheet.Range("A" & FromRow & ":D" & FromRow).Value
                ToRow = ToRow + 1
            End If
        Next FromRow
        '--------------------------------------------------------------------
        '- next criteria row
        CriteriaRow = CriteriaRow + 1
    Wend
    '------------------------------------------------------------------------
    MsgBox ("Done")
     Application.Calculation = xlCalculationAutomatic
End Sub
'===============================================================================