VBA Advanced Filtering

pharris81

New Member
Joined
Apr 15, 2014
Messages
21
Hi there,
I've got a macro that take a value from a list(say ABC) from a sheet called "Names", creates a new worksheet called "ABC", runs a filter on column A in worksheet "Data" for cells containing "ABC", then copies and pastes those rows to the new worksheet "ABC". The problem is that the filter isn't working. It copies and pastes the entire source sheet, rather than filtered rows.

Please help me...I'm a total noob.

The code I have is:

Code:
Sub Create_Sheets()
Dim rRange As Range, rCell As Range
Dim wSheet As Worksheet
Dim wSheetStart As Worksheet
Dim strText As String

    Set wSheetStart = Sheets("SurveyData")
    wSheetStart.AutoFilterMode = False
    'Set a range variable to the correct item column
    'Set rRange = Sheets("SurveyData").Range("A1", Range("A65536").End(xlUp))
    

        On Error Resume Next
        Application.DisplayAlerts = False
                 
        With Worksheets("Names")
                 'Set a range variable to the list of names, less the heading.
                 Set rRange = .Range("A2", .Range("A65536").End(xlUp))
            End With
            
            On Error Resume Next
            With wSheetStart
                For Each rCell In rRange
                  strText = rCell
                 .Range("A1").AdvancedFilter Action:=xlFilterCopy, _
                 Criteriarange:=strText
                    Worksheets(strText).Delete
                    'Add a sheet named as content of rCell
                    Worksheets.Add().Name = strText
                    'Copy the visible filtered range _
                    (default of Copy Method) and leave hidden rows
                    .UsedRange.Copy Destination:=ActiveSheet.Range("A1")
                    ActiveSheet.Cells.Columns.AutoFit
                Next rCell
            End With
            
        With wSheetStart
            .AutoFilterMode = False
            .Activate
        End With
        
        On Error GoTo 0
        Application.DisplayAlerts = True
End Sub

Thanks very much for any assistance.

Cheers,
Peter
 

Excel Facts

Is there a shortcut key for strikethrough?
Ctrl+S is used for Save. Ctrl+5 is used for Strikethrough. Why Ctrl+5? When you use hashmarks to count |||| is 4, strike through to mean 5.
Your criteria range for an advanced filter has to be an actual range, not a value.
 
Upvote 0
Hi Rory,
Thanks for your response. I mucked around with the code last Friday and I got it working in the following form. I thought I'd post it up in its working form so others might be able to use it if their requirements are similar. Any critique or suggestions would be greatly appreciated.

Code:
Sub Create_Sheets()
Dim rRange As Range, rCell As Range
Dim wSheet As Worksheet
Dim wSheetStart As Worksheet
Dim strText As String

    Set wSheetStart = Sheets("SurveyData")
    wSheetStart.AutoFilterMode = False
    'Set a range variable to the correct item column
    'Set rRange = Sheets("SurveyData").Range("A1", Range("A65536").End(xlUp))
    

        On Error Resume Next
        Application.DisplayAlerts = False
                 
        With Worksheets("Names")
                 'Set a range variable to the list of names, less the heading.
                 Set rRange = .Range("A2", .Range("A65536").End(xlUp))
            End With
            
            On Error Resume Next
            With wSheetStart
                For Each rCell In rRange
                  strText = rCell
                 .Range("A1").AutoFilter 1, "*" & strText & "*"
                    Worksheets(strText).Delete
                    'Add a sheet named as content of rCell
                    Worksheets.Add().Name = strText
                    'Copy the visible filtered range _
                    (default of Copy Method) and leave hidden rows
                    .UsedRange.Copy Destination:=ActiveSheet.Range("A1")
                    ActiveSheet.Cells.Columns.AutoFit
                Next rCell
            End With
            
        With wSheetStart
            .AutoFilterMode = False
            .Activate
        End With
        
        On Error GoTo 0
        Application.DisplayAlerts = True
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,486
Messages
6,113,932
Members
448,533
Latest member
thietbibeboiwasaco

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