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.
Simon wrote:
When we have two tabelles. The lines between those two tabelles correspond.
For example line 6 to 54 in tabelle 1 have the same referenece as the line 6
to 54 in tabelle 2.
When I do a filter in Tabelle 1. It selectes for example from line 10 to 15.
But when I swish to tabelle 2 it doesn t show the lines selected in tabelle 1.
How can I make a relation from the tabelle two to the filter in the tabelle 1?
Thank you.
--
Dave Peterson
|