![]() |
Autofilter - Link to 2nd worksheet?
Hi all,
I am putting 2 filters on 2 worksheets in the SAME WORKBOOK. I would like to see if I can do something like this: 1. if I click the filter on worksheet1 and select a value, it can be passed to the filter on worksheet2 and shown the corrensponding result on worksheet 2. 2. Vice versa, when i click the filter on worksheet 2, the same effect will apply to worksheet 1. FYI, the columns on each worksheet has the same format. Thanks alot~ |
Saved from a previous post:
This seems to work ok for me. This code is placed behind the ThisWorkbook module. Change sheet1 and sheet2 to the names of the worksheets that contain your two tables: Option Explicit Private Sub Workbook_SheetActivate(ByVal Sh As Object) Const DummyString As String = "DummyString" Dim OtherSheet As Worksheet Dim myCell As Range Dim fCtr As Long Dim myCriteria1 As String Dim myCriteria2 As String Dim myOperator As Long Dim iCtr As Long Select Case LCase(Sh.Name) Case Is = "sheet1" Set OtherSheet = Worksheets("Sheet2") Case Is = "sheet2" Set OtherSheet = Worksheets("Sheet1") Case Else 'get out Exit Sub End Select If OtherSheet.AutoFilterMode = False _ Or Sh.AutoFilterMode = False Then MsgBox "Please apply filters to both sheets!" Exit Sub End If If OtherSheet.AutoFilter.Range.Columns.Count _ < Sh.AutoFilter.Range.Columns.Count Then MsgBox "Filters don't have the same number of columns!" Exit Sub End If 'show all the data to get started With Sh If .FilterMode Then .ShowAllData End If End With fCtr = 1 For Each myCell In Sh.AutoFilter.Range.Rows(1).Cells With OtherSheet.AutoFilter.Filters(fCtr) If .On = True Then myCriteria1 = DummyString myCriteria2 = DummyString myOperator = 0 On Error Resume Next myCriteria1 = .Criteria1 myCriteria2 = .Criteria2 myOperator = .Operator On Error GoTo 0 Select Case myOperator Case Is = xlAnd, xlOr 'do nothing Case Is = xlTop10Items, xlBottom10Items, _ xlTop10Percent, xlBottom10Percent If myCriteria1 = DummyString Then 'do nothing Else For iCtr = 1 To Len(myCriteria1) If IsNumeric(Mid(myCriteria1, iCtr, 1)) Then 'do nothing Else Mid(myCriteria1, iCtr, 1) = " " End If Next iCtr myCriteria1 _ = Application.Substitute(myCriteria1, " ", "") End If If myCriteria2 = DummyString Then 'do nothing Else For iCtr = 1 To Len(myCriteria2) If IsNumeric(Mid(myCriteria2, iCtr, 1)) Then 'do nothing Else Mid(myCriteria2, iCtr, 1) = " " End If Next iCtr myCriteria2 _ = Application.Substitute(myCriteria2, " ", "") End If Case Else myOperator = xlAnd End Select If myCriteria1 = DummyString Then If myCriteria2 = DummyString Then Sh.AutoFilter.Range.AutoFilter _ Field:=fCtr, _ Operator:=myOperator Else Sh.AutoFilter.Range.AutoFilter _ Field:=fCtr, _ Operator:=myOperator, Criteria2:=myCriteria2 End If Else If myCriteria2 = DummyString Then Sh.AutoFilter.Range.AutoFilter _ Field:=fCtr, Criteria1:=myCriteria1, _ Operator:=myOperator Else Sh.AutoFilter.Range.AutoFilter _ Field:=fCtr, Criteria1:=myCriteria1, _ Operator:=myOperator, Criteria2:=myCriteria2 End If End If End If End With fCtr = fCtr + 1 Next myCell End Sub This routine gets invoked when you select a worksheet. The last worksheet that you selected becomes the "master" worksheet. Swap to the other and it'll show the same filter as the sheet you just left. === If you're new to macros, you may want to read David McRitchie's intro at: http://www.mvps.org/dmcritchie/excel/getstarted.htm "Kingsley H via OfficeKB.com" wrote: Hi all, I am putting 2 filters on 2 worksheets in the SAME WORKBOOK. I would like to see if I can do something like this: 1. if I click the filter on worksheet1 and select a value, it can be passed to the filter on worksheet2 and shown the corrensponding result on worksheet 2. 2. Vice versa, when i click the filter on worksheet 2, the same effect will apply to worksheet 1. FYI, the columns on each worksheet has the same format. Thanks alot~ -- Dave Peterson |
All times are GMT +1. The time now is 10:42 AM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com