![]() |
#1
|
|||
|
|||
![]()
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 |
#2
|
|||
|
|||
![]()
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 |
#3
|
|||
|
|||
![]() ![]() 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? |
![]() |
Tags |
filtering, vba |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
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 |
![]() |
kwlickt | Excel | 1 | 03-28-2011 11:15 AM |