Need a Macro code to filter & unselect a specific value.

Y

Yup

New Member
Joined
Sep 6, 2022
Messages
13
Office Version
  1. 365
Platform
  1. Windows
Hi, I have to copy rows from one sheet to other in a same excel file. It's a repetitive task. Consider following example.

NameDevicescode
ADesktop234
BLaptop2345
CLaptop3456
DSmartphone7654
EPrinter3456
FDesktop098
GScanner123
HLaptop65
ISmartphone876
JLaptop345

I need to filter column "Devices". Unselect "Smartphone". Copy rows & Paste.
But the column "Devices" may contain other values from selective range that may or may not be present every time e.g. Television.
I need a code that will satisfy these conditions.
 

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.
Sort by date Sort by votes
I hope that this does what is needed...

VBA Code: 
Option Explicit

Sub FilterBasedOnCriterion()

    Dim iLastSheetRow As Long
    
    Dim iDataRowsCount As Long
    
    Dim iRowToPaste As Long

    Dim rCell As Range
    
'   Clear any data in worksheet 2 into which "new" data will be pasted.
    Worksheets("Sheet2").Range("Header_Name").Offset(1).Resize(1000, 3).Clear

'   Data to copy is in sheet 1
    With Worksheets("Sheet1")
    
'       Clear existing filtering. If there is no filter then .ShowAllData causes an error.
        On Error Resume Next
        .ShowAllData
        On Error GoTo 0
            
'       Apply filter to range specified using criteria (criterion in this case)
        .Range("E5:G15").AdvancedFilter _
            Action:=xlFilterInPlace, _
            CriteriaRange:=Range("I2:I3"), _
            Unique:=False
            
'       Use cell named Header_Name in sheet 1 as "anchor" for data to copy.
        With .Range("Header_Name")
        
'           Get last sheet row containing data.
            iLastSheetRow = .End(xlDown).Row

'           Get count of all data rows.
            iDataRowsCount = iLastSheetRow - .Row
            
        End With '.Range("Header_Name")
        
'       Loop rows of data to copy in sheet 1.
        For Each rCell In .Range("Header_Name").Offset(1).Resize(iDataRowsCount)
        
'           Filtered rows are hidden
            If Not rCell.EntireRow.Hidden _
             Then
             
'               Increment count of DATA row # to paste to in sheet 2
                iRowToPaste = iRowToPaste + 1
                
'               Copy three cells in the exposed row in sheet 1, filtered data.
                rCell.Resize(1, 3).Copy
                
'               Paste values into the other sheet.
'               Use cell named Header_Name in sheet 2 as "anchor" for pasting data.
                Worksheets("Sheet2").Range("Header_Name").Offset(iRowToPaste).PasteSpecial Paste:=xlPasteValues
            
            End If
        
        Next rCell

    End With 'Worksheets("Sheet1")

End Sub

Sub ClearFilterBasedOnCriterion()
    Worksheets("Sheet1").ShowAllData
End Sub

That code is in this workbook...Workbook
 
Upvote 1
Similar to your other Question - try this (changing sheet names, destination etc. to suit)

VBA Code: 
Option Explicit
Sub Copy_Array_2()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")  '<~~ change to suit
    Set ws2 = Worksheets("Sheet2")  '<~~ change to suit
    
    With ws1.Range("A1").CurrentRegion
        .AutoFilter 2, "<>Smartphone"
        If ws1.Cells(Rows.Count, 1).End(xlUp).Row > 1 Then
            .Offset(1).Resize(.Rows.Count - 1).Copy ws2.Range("A2") '<~~ change destination to suit
        End If
        .AutoFilter
    End With

End Sub
 
Upvote 1
Solution
OaklandJim said:
I hope that this does what is needed...

VBA Code: 
Option Explicit

Sub FilterBasedOnCriterion()

    Dim iLastSheetRow As Long
   
    Dim iDataRowsCount As Long
   
    Dim iRowToPaste As Long

    Dim rCell As Range
   
'   Clear any data in worksheet 2 into which "new" data will be pasted.
    Worksheets("Sheet2").Range("Header_Name").Offset(1).Resize(1000, 3).Clear

'   Data to copy is in sheet 1
    With Worksheets("Sheet1")
   
'       Clear existing filtering. If there is no filter then .ShowAllData causes an error.
        On Error Resume Next
        .ShowAllData
        On Error GoTo 0
           
'       Apply filter to range specified using criteria (criterion in this case)
        .Range("E5:G15").AdvancedFilter _
            Action:=xlFilterInPlace, _
            CriteriaRange:=Range("I2:I3"), _
            Unique:=False
           
'       Use cell named Header_Name in sheet 1 as "anchor" for data to copy.
        With .Range("Header_Name")
       
'           Get last sheet row containing data.
            iLastSheetRow = .End(xlDown).Row

'           Get count of all data rows.
            iDataRowsCount = iLastSheetRow - .Row
           
        End With '.Range("Header_Name")
       
'       Loop rows of data to copy in sheet 1.
        For Each rCell In .Range("Header_Name").Offset(1).Resize(iDataRowsCount)
       
'           Filtered rows are hidden
            If Not rCell.EntireRow.Hidden _
             Then
            
'               Increment count of DATA row # to paste to in sheet 2
                iRowToPaste = iRowToPaste + 1
               
'               Copy three cells in the exposed row in sheet 1, filtered data.
                rCell.Resize(1, 3).Copy
               
'               Paste values into the other sheet.
'               Use cell named Header_Name in sheet 2 as "anchor" for pasting data.
                Worksheets("Sheet2").Range("Header_Name").Offset(iRowToPaste).PasteSpecial Paste:=xlPasteValues
           
            End If
       
        Next rCell

    End With 'Worksheets("Sheet1")

End Sub

Sub ClearFilterBasedOnCriterion()
    Worksheets("Sheet1").ShowAllData
End Sub

That code is in this workbook...Workbook
Click to expand...

Hi,
Thanks :)
 
Upvote 0
kevin9999 said:
Similar to your other Question - try this (changing sheet names, destination etc. to suit)

VBA Code: 
Option Explicit
Sub Copy_Array_2()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")  '<~~ change to suit
    Set ws2 = Worksheets("Sheet2")  '<~~ change to suit
   
    With ws1.Range("A1").CurrentRegion
        .AutoFilter 2, "<>Smartphone"
        If ws1.Cells(Rows.Count, 1).End(xlUp).Row > 1 Then
            .Offset(1).Resize(.Rows.Count - 1).Copy ws2.Range("A2") '<~~ change destination to suit
        End If
        .AutoFilter
    End With

End Sub
Click to expand...

Hi,
Thanks, this helped a lot. :)

Some minor queries.
1) My data in sheet one actually started from 'B2' 'A' column is actually 'Sr. No.' I tried to modify code by
ws1.Range("$B$2:$W$101")
Click to expand...
but it didn't work.

2) I also have to pre-apply another filter to another column with 2 criterias. can you guide in that matter ?

Thanks in advance :)
 
Upvote 0
If you could provide a copy of your actual sheet using the XL2BB add in I would be happy to help. Also indicate which other column you want to apply the filter on and by what criteria. As a bit of a guide, additional columns/criteria could look something like this (additional column 3 added with 2 x criteria)

VBA Code: 
With ws1.Range("A1").CurrentRegion
        .AutoFilter 2, "<>Smartphone"
        .AutoFilter 3, "Something", xlAnd, "<>Something else"
 
Upvote 0
kevin9999 said:
If you could provide a copy of your actual sheet using the XL2BB add in I would be happy to help. Also indicate which other column you want to apply the filter on and by what criteria. As a bit of a guide, additional columns/criteria could look something like this (additional column 3 added with 2 x criteria)

VBA Code: 
With ws1.Range("A1").CurrentRegion
        .AutoFilter 2, "<>Smartphone"
        .AutoFilter 3, "Something", xlAnd, "<>Something else"
Click to expand...

Hi,
Sorry 😅. data is confidential. So, I can't share the sheet.
It is quite similar to this table.
Sr. No.NameDevicescode
1ADesktop234
2BLaptopN2345
3CTelevision3456
4DSmartphone7654
5EPrinterNA
6FDesktopOp098
7GScannerNA
8HLaptopNA
9ISmartphoneSA876
10JLaptop345QT
11K
12LTelevision3456
13MNANA
14NLaptopGH1234
15ODesktop8797

Instead here is the code I am using

VBA Code: 
Sub Macro1()
'
' Macro1 Macro
' Trial1
'
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")  '<~~ change to suit
    Set ws2 = Worksheets("Sheet2")  '<~~ change to suit
    
    With ws1.Range("A1").CurrentRegion
    .AutoFilter 3, "Laptop", xlAnd, "Desktop"
    .AutoFilter 4, "<>NA", xlAnd, "<>"
        If ws1.Cells(Rows.Count, 1).End(xlUp).Row > 1 Then
            .Offset(1).Resize(.Rows.Count - 1).Copy ws2.Range("B3") '<~~ change destination to suit
        End If
        .AutoFilter
    End With
'
End Sub

I have modified the code as per my need.
but following issues are present.
1) When I run this code, absolutely nothing is happening. :(
There is no error & no data being copy pasted either.
It worked when there was only single AutoFilter.
2) While copying data from sheet1, I want to copy data from column 'B' & paste it in sheet2 from Cell 'B3'.
3) I also want to implement, following code in the above macro.

VBA Code: 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

Thanks in Advance :)
 
Upvote 0
The problem is you first autofilter criteria is that you're asking to display rows where there is both "Laptop" AND "Desktop" in column 3 - it should be OR.

Try the following:
VBA Code: 
Option Explicit
Sub Macro1()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")  '<~~ change to suit
    Set ws2 = Worksheets("Sheet2")  '<~~ change to suit
    
    With ws1.Range("A1").CurrentRegion
        .AutoFilter 3, "Laptop", 2, "Desktop"
        .AutoFilter 4, "<>NA", 1, "<>"
        If ws.UsedRange.SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then
            .Offset(1).Resize(.Rows.Count - 1).Copy
            ws2.Range("B3").PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End If
        .AutoFilter
    End With
End Sub
 
Upvote 1
kevin9999 said:
The problem is you first autofilter criteria is that you're asking to display rows where there is both "Laptop" AND "Desktop" in column 3 - it should be OR.

Try the following:
VBA Code: 
Option Explicit
Sub Macro1()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Set ws1 = Worksheets("Sheet1")  '<~~ change to suit
    Set ws2 = Worksheets("Sheet2")  '<~~ change to suit
   
    With ws1.Range("A1").CurrentRegion
        .AutoFilter 3, "Laptop", 2, "Desktop"
        .AutoFilter 4, "<>NA", 1, "<>"
        If ws.UsedRange.SpecialCells(xlCellTypeVisible).Rows.Count > 1 Then
            .Offset(1).Resize(.Rows.Count - 1).Copy
            ws2.Range("B3").PasteSpecial xlPasteValues
            Application.CutCopyMode = False
        End If
        .AutoFilter
    End With
End Sub
Click to expand...
Hi,
Thanks. It helped a lot.

Just a quick question,

.AutoFilter 3, "Laptop", 2, "Desktop"
Click to expand...

can I use the same autofilter code for more than 2 criteria ? i.e.
VBA Code: 
 .AutoFilter 3, "Laptop", xlOr, "Desktop", xlOr, "Smartphone"
If not, what should be the replacement line for xlOr with more than 2 criterias?
 
Upvote 0
Unfortunately, autofilter only allows 2 criteria using the xlOr option. There are workarounds (e.g. advanced filter) so if you start a new thread with all the criteria you may want then you should get a solution.
 
Upvote 1
You must log in or register to reply here.

Similar threads

Y
  • Locked
  • Solved
Macro code to autofilter & select dynamic data.
Replies
2
Views
246
Fluff
Fluff
Y
  • Locked
  • Solved
Need macro snippet for Filtering Non-Repetitive, Dynamic data/values for Repetitive macro usage.
Replies
9
Views
341
Fluff
Fluff
Y
  • Solved
Copy/paste dynamic, filtered data + put a column into next row (through macro)
Replies
2
Views
860
YourBroLucas
Y
C
  • Question
Creating a Dynamic Criteria Range for Advanced Filter Macro
Replies
5
Views
8K
cypressknees
C

Forum statistics

Threads
1,214,574
Messages
6,120,327
Members
448,956
Latest member
Adamsxl

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top