ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Discussion (Misc queries) (https://www.excelbanter.com/excel-discussion-misc-queries/)
-   -   Excel2000: Filter from tabelle 1 related to tabelle 2 ? (https://www.excelbanter.com/excel-discussion-misc-queries/23632-excel2000-filter-tabelle-1-related-tabelle-2-a.html)

Simon

Excel2000: Filter from tabelle 1 related to tabelle 2 ?
 
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

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

Simon

Thank you very much for your answer.

I would also like to know how to do it with a german computer.
That is why I asked the question in the german forum, but I still haven t
gotten any answer. Do you think you could manege this.
Thank you in advance

"Dave Peterson" schrieb:

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


Dave Peterson

Try it on your German PC.

From what I understand, the code shouldn't change. (But you could translate the
message boxes to Deutsch!)



Simon wrote:

Thank you very much for your answer.

I would also like to know how to do it with a german computer.
That is why I asked the question in the german forum, but I still haven t
gotten any answer. Do you think you could manege this.
Thank you in advance

"Dave Peterson" schrieb:

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


--

Dave Peterson


All times are GMT +1. The time now is 02:30 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com