• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

Apply auto filter and copy data one below other in next sheet

A

Anand307

Member
We have a workbook in which we need to copy only the required data to sheet "CP + Party" from sheet Raw Data,
1. First in Raw Data sheet apply filter in column D as contains "Fender" or "JBL" or "SANTIAGO" copy the data (Column A to E) to next sheet by name "CP + Party" paste starting row 2.
2. Secondly in Raw Data sheet apply filter in column E as contains "Fender" or "JBL" or "SANTIAGO" copy the data (Column A to E) to next sheet by name "CP + Party", paste below the previously pasted data.

I have a recorded macro (recorded on relative mode), however iam getting an error with this, please help needed to build this in a better and consistent way or suggest. Attached sample workbook.
 

Attachments

  • Sample two columns filter.xls
    56 KB · Views: 7
Code: 
Sub colDrelative()

'

' colDrelative Macro

'



'

  Application.Goto Reference:="R1C1"

  Range(Selection, Selection.End(xlToRight)).Select

  Range(Selection, Selection.End(xlDown)).Select

  Selection.AutoFilter

  ActiveCell.Select

  Application.Goto Reference:="R1C4"

  ActiveSheet.Range("$A$1:$E$17174").AutoFilter Field:=4, Criteria1:= _

  "=*carval*", Operator:=xlOr, Criteria2:="=*rothesay*", Operator:=xlOr, Criteria2:="=*Secor*"  'active range is until last line data in column A

  Application.Goto Reference:="R1C1"

  ActiveCell.Offset(138, 0).Range("A1").Select

  Range(Selection, Selection.End(xlToRight)).Select

  Range(Selection, Selection.End(xlDown)).Select

  Selection.Copy

  ActiveSheet.Next.Select

  Application.Goto Reference:="R1C1"

  ActiveCell.Offset(1, 0).Range("A1").Select

  ActiveSheet.Paste

  ActiveSheet.Previous.Select

  Application.CutCopyMode = False

  ActiveSheet.ShowAllData

  Application.Goto Reference:="R1C5"

  ActiveSheet.Range("$A$1:$E$17174").AutoFilter Field:=5, Criteria1:= _

  "=*carval*", Operator:=xlOr, Criteria2:="=*rothesay*", Operator:=xlOr, Criteria2:="=*Secor*"

  Application.Goto Reference:="R1C1"

  ActiveCell.Offset(1, 0).Range("A1").Select

  Range(Selection, Selection.End(xlToRight)).Select

  Range(Selection, Selection.End(xlDown)).Select

  Selection.Copy

  ActiveSheet.Next.Select

  Application.Goto Reference:="R1C1"

  Selection.End(xlDown).Select

  ActiveCell.Offset(1, 0).Range("A1").Select

  ActiveSheet.Paste

  Range("A1").Select

End Sub
 
Hi @Anand307

Try this and see if it's what you were looking for:
Code: 
Sub Macro()

    On Error Resume Next

    Dim lrow, lrow2 As Integer

    'Clear contents from "CP + Party"
     lrow = Sheets("CP + Party").Range("A2").End(xlDown).Row
    Sheets("Cp + Party").Rows("2:" & lrow).ClearContents

    'Clear filters and aplly filter to column D
     Sheets("Raw Data").ShowAllData
    Sheets("Raw Data").Columns("A:E").AutoFilter Field:=4, Criteria1:=Array("FENDER", "JBL", "SANTIAGO"), Operator:=xlFilterValues

    'Copy data and paste from cell A2 of "CP + Party"
     lrow = Sheets("Raw Data").Range("A2").End(xlDown).Row
    Sheets("Raw Data").Range("A2:E" & lrow).Copy Sheets("CP + Party").Range("A2")


    'Clear filters and aplly new filter to column E
     Sheets("Raw Data").ShowAllData
    Sheets("Raw Data").Columns("A:E").AutoFilter Field:=5, Criteria1:=Array("FENDER", "JBL", "SANTIAGO"), Operator:=xlFilterValues

    'Copy data and paste after previous
     lrow = Sheets("Raw Data").Range("A2").End(xlDown).Row
    lrow2 = Sheets("CP + Party").Range("A2").End(xlDown).Row + 1
    Sheets("Raw Data").Range("A2:E" & lrow).Copy Sheets("CP + Party").Range("A" & lrow2)

End Sub

Regards
 
Last edited:
How to make filer work for cells where the filter criteria would be as "Fender-Samf" or "ITIFS-JBL", though we have filter criteria as "Fender" this tends to miss out few items in column D and E, hence I tried to amend the code as
Code: 
 Sheets("Raw Data").Columns("A:E").AutoFilter Field:=4, Criteria1:=Array( "=*FENDER*", "=*JBL*", "=*SANTIAGO*"), Operator:=xlFilterValues
but I see this amended method is not working.
 
Anand307 said:
How to make filer work for cells where the filter criteria would be as "Fender-Samf" or "ITIFS-JBL", though we have filter criteria as "Fender" this tends to miss out few items in column D and E, hence I tried to amend the code as
Code: 
 Sheets("Raw Data").Columns("A:E").AutoFilter Field:=4, Criteria1:=Array( "=*FENDER*", "=*JBL*", "=*SANTIAGO*"), Operator:=xlFilterValues
but I see this amended method is not working.
Click to expand...

Hi,

As far as I know it is a limitation of the autofilter... which can only hold up to 2 criteria of the "containing" type, even in the UI.

It may be possible to use advanced filters though...
 
Here it goes,

See attached...

For the advanced filter you need a range with the criteria so I used the sheet "Cp + Party"... if that location isn't optimal you can move it, but the code must be altered to reflect the changes

Edit: alternatively you can give names to both ranges and use them in the code below, effectively eliminating the need for further tinkering with the code (as long as the names of the ranges remain the same from that moment on):

Simply replace
Sheets("CP + Party").Range("J1:J4")
Sheets("CP + Party").Range("K1:K4")

with the names of the ranges in []

Code: 
Sub Macro()

    On Error Resume Next

    Dim lrow, lrow2 As Integer

    'Clear contents from "CP + Party"
    lrow = Sheets("CP + Party").Range("A2").End(xlDown).Row
    Sheets("Cp + Party").Range("A2:E" & lrow).ClearContents

    'Clear filters and aplly filter to column D
    Sheets("Raw Data").ShowAllData
    Sheets("Raw Data").Columns("A:E").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Sheets("CP + Party").Range("J1:J4"), Unique:=False

    'Copy data and paste from cell A2 of "CP + Party"
    lrow = Sheets("Raw Data").Range("A2").End(xlDown).Row
    Sheets("Raw Data").Range("A2:E" & lrow).Copy Sheets("CP + Party").Range("A2")


    'Clear filters and aplly new filter to column E
    Sheets("Raw Data").ShowAllData
    Sheets("Raw Data").Columns("A:E").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Sheets("CP + Party").Range("K1:K4"), Unique:=False

    'Copy data and paste after previous
    lrow = Sheets("Raw Data").Range("A2").End(xlDown).Row
    lrow2 = Sheets("CP + Party").Range("A2").End(xlDown).Row + 1
    Sheets("Raw Data").Range("A2:E" & lrow).Copy Sheets("CP + Party").Range("A" & lrow2)

End Sub

Let me know how it went :)
 

Attachments

  • Sample two columns filter.xls
    85.5 KB · Views: 17
Last edited:
PCosta87 said:
Here it goes,

See attached...

For the advanced filter you need a range with the criteria so I used the sheet "Cp + Party"... if that location isn't optimal you can move it, but the code must be altered to reflect the changes

Edit: alternatively you can give names to both ranges and use them in the code below, effectively eliminating the need for further tinkering with the code (as long as the names of the ranges remain the same from that moment on):

Simply replace
Sheets("CP + Party").Range("J1:J4")
Sheets("CP + Party").Range("K1:K4")

with the names of the ranges in []

Code: 
Sub Macro()

    On Error Resume Next

    Dim lrow, lrow2 As Integer

    'Clear contents from "CP + Party"
    lrow = Sheets("CP + Party").Range("A2").End(xlDown).Row
    Sheets("Cp + Party").Range("A2:E" & lrow).ClearContents

    'Clear filters and aplly filter to column D
    Sheets("Raw Data").ShowAllData
    Sheets("Raw Data").Columns("A:E").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Sheets("CP + Party").Range("J1:J4"), Unique:=False

    'Copy data and paste from cell A2 of "CP + Party"
    lrow = Sheets("Raw Data").Range("A2").End(xlDown).Row
    Sheets("Raw Data").Range("A2:E" & lrow).Copy Sheets("CP + Party").Range("A2")


    'Clear filters and aplly new filter to column E
    Sheets("Raw Data").ShowAllData
    Sheets("Raw Data").Columns("A:E").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
        Sheets("CP + Party").Range("K1:K4"), Unique:=False

    'Copy data and paste after previous
    lrow = Sheets("Raw Data").Range("A2").End(xlDown).Row
    lrow2 = Sheets("CP + Party").Range("A2").End(xlDown).Row + 1
    Sheets("Raw Data").Range("A2:E" & lrow).Copy Sheets("CP + Party").Range("A" & lrow2)

End Sub

Let me know how it went :)
Click to expand...
Hi
PCosta87 said:
You're welcome ;)
Click to expand...

Hi Mate,

Thank you for the hep!

Yeah it works but.. I need to apply filter and keep the data as is. No copy-paste stuff. Just apply filter and uncheck those 3 values and keep filter on.. no copy-paste.

Please help!


Regards,
Mahantesh
 
You must log in or register to reply here.
Back
Top