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

Thread Tools
Display Modes


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 01:17 AM.


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