Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 10-13-2016, 05:20 AM
SavGDK SavGDK is offline VBA Filter Windows 7 32bit VBA Filter Office 2010 32bit
Novice
VBA Filter
 
Join Date: Apr 2016
Location: Savannah Ga
Posts: 20
SavGDK is on a distinguished road
Default VBA Filter

I am hoping somebody can help me with a VBA issue. I have multiple worksheets with a filtering equation set up on each sheet. On the main page of the workbook I want to set up a filter that will automatically filter all the pages. I have attached a screenshot of my VBA Code. I eventually want to add all the pages to this code but thought it would be easier to start with one page.

Thank you,



Dan
Attached Images
File Type: jpg VBA Code.JPG (39.5 KB, 28 views)
Reply With Quote
  #2  
Old 10-13-2016, 12:45 PM
charlesdh charlesdh is offline VBA Filter Windows 7 32bit VBA Filter Office 2010 32bit
Expert
 
Join Date: Apr 2014
Location: Mississippi
Posts: 382
charlesdh is on a distinguished road
Default

Hi,

You can look at this code too see if it will help you.
It loops thru specific sheet and applies a filter then copy and paste to a worksheet.

Code:
Sub test41()
Application.ScreenUpdating = False
Dim ws As Worksheet
Dim Sws As Worksheet
Dim Rng As Range
Dim Myval As Long
Set Sws = Sheets("Summary")
'''' Unhide Summary columns "K thru Q'''''
Sws.Columns("K:Q").Hidden = True
''''
For Each ws In ActiveWorkbook.Worksheets
    ws.Activate
    If InStr("Lookup", ws.Name) = 0 And InStr("Summary", ws.Name) = 0 Then
    Select Case ws.Name
         Case "Crawler"
            Range("A1:d1").Select
            ws.Columns("K:R").Hidden = False
            Selection.AutoFilter
            With Selection
                .AutoFilter Field:=1, Criteria1:="<>F" '' this set the filtered data for the value"
            End With
            Set Rng = ActiveSheet.AutoFilter.Range
            lrow = ActiveSheet.Range("A65536").End(xlUp).Row
            '' make sure you have more than 1 row to copy ''
            Myval = Range("a2:a" & lrow).SpecialCells(xlCellTypeVisible).Count
            If Myval <> "1" Then
               Rlrow = Sheets("Summary").Range("A65536").End(xlUp).Row + 1
                    Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, 22).Copy
                        Sheets("Summary").Cells(Rlrow, 1).PasteSpecial xlAll
                    Application.CutCopyMode = xlCopy
            End If
        Case "Various"
            Range("A1:d1").Select
            ws.Columns("K:R").Hidden = False
            Selection.AutoFilter
            With Selection
                .AutoFilter Field:=1, Criteria1:="<>F" '' this set the filtered data for the value"
            End With
            Set Rng = ActiveSheet.AutoFilter.Range
            lrow = ActiveSheet.Range("A65536").End(xlUp).Row
            '' make sure you have more than 1 row to copy ''
            Myval = Range("a2:a" & lrow).SpecialCells(xlCellTypeVisible).Count
            If Myval <> "1" Then
               Rlrow = Sheets("Summary").Range("A65536").End(xlUp).Row + 1
                    Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, 22).Copy
                        Sheets("Summary").Cells(Rlrow, 1).PasteSpecial xlAll
                    Application.CutCopyMode = xlCopy
            End If
        Case "MandM"
            Range("A1:d1").Select
            ws.Columns("K:R").Hidden = False
            Selection.AutoFilter
            With Selection
                .AutoFilter Field:=1, Criteria1:="<>F" '' this set the filtered data for the value"
            End With
            Set Rng = ActiveSheet.AutoFilter.Range
            lrow = ActiveSheet.Range("A65536").End(xlUp).Row
            '' make sure you have more than 1 row to copy ''
            Myval = Range("a2:a" & lrow).SpecialCells(xlCellTypeVisible).Count
            If Myval <> "1" Then
               Rlrow = Sheets("Summary").Range("A65536").End(xlUp).Row + 1
                    Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, 22).Copy
                        Sheets("Summary").Cells(Rlrow, 1).PasteSpecial xlAll
                    Application.CutCopyMode = xlCopy
            End If
        Case "Fragrance"
            Range("A1:d1").Select
            ws.Columns("K:R").Hidden = False
            Selection.AutoFilter
            With Selection
                .AutoFilter Field:=1, Criteria1:="<>F" '' this set the filtered data for the value"
            End With
            Set Rng = ActiveSheet.AutoFilter.Range
            lrow = ActiveSheet.Range("A65536").End(xlUp).Row
            '' make sure you have more than 1 row to copy ''
            Myval = Range("a2:a" & lrow).SpecialCells(xlCellTypeVisible).Count
            If Myval <> "1" Then
               Rlrow = Sheets("Summary").Range("A65536").End(xlUp).Row + 1
                    Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, 22).Copy
                        Sheets("Summary").Cells(Rlrow, 1).PasteSpecial xlAll
                    Application.CutCopyMode = xlCopy
            End If
        Case "5£"
            Range("A1:d1").Select
            ws.Columns("K:R").Hidden = False
            Selection.AutoFilter
            With Selection
                .AutoFilter Field:=1, Criteria1:="<>F" '' this set the filtered data for the value"
            End With
            Set Rng = ActiveSheet.AutoFilter.Range
            lrow = ActiveSheet.Range("A65536").End(xlUp).Row
            '' make sure you have more than 1 row to copy ''
            Myval = Range("a2:a" & lrow).SpecialCells(xlCellTypeVisible).Count
            If Myval <> "1" Then
               Rlrow = Sheets("Summary").Range("A65536").End(xlUp).Row + 1
                    Rng.Offset(1, 0).Resize(Rng.Rows.Count - 1, 22).Copy
                        Sheets("Summary").Cells(Rlrow, 1).PasteSpecial xlAll
                    Application.CutCopyMode = xlCopy
            End If
        Case Else
        '''' Activate Summary and Hide columns '''

            Sws.Activate
            Sws.Range("A1").Select
            Sws.Columns("K:Q").Hidden = True
            Exit Sub
    End Select
    Selection.AutoFilter
    End If
    ws.Columns("K:R").Hidden = True
Next ws
End Sub
Reply With Quote
  #3  
Old 10-14-2016, 11:37 AM
SavGDK SavGDK is offline VBA Filter Windows 7 32bit VBA Filter Office 2010 32bit
Novice
VBA Filter
 
Join Date: Apr 2016
Location: Savannah Ga
Posts: 20
SavGDK is on a distinguished road
Default

Charles,

Thanks for the help. I will give it a try. I was hoping it would be a little simpler than creating a copy. My workbook is already really big. If I attach the workbook would that help?
Reply With Quote
Reply

Tags
filtering, vba



Similar Threads
Thread Thread Starter Forum Replies Last Post
VBA Filter Filter Mail Merge based on a list of filter criteria AusSteelMan Mail Merge 2 05-09-2016 03:35 PM
how to filter using hyperlick? nicholes Excel Programming 20 04-16-2015 03:54 AM
Help Date filter Herve86 Outlook 0 05-28-2012 04:43 AM
Apply filter with VBA bobsawyer7 Outlook 0 03-12-2012 04:02 AM
VBA Filter filter kwlickt Excel 1 03-28-2011 11:15 AM

Other Forums: Access Forums

All times are GMT -7. The time now is 10:49 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft