With Microsoft still not providing automated notifications I missed checking
this earlier and I am a bit late getting back to you. I am periodically
checking my posts via my profile so I will eventually get back on all posts.

OK but need to confirm info regarding the list of projects.

Am I correct in assuming that you mean create a dropdown list by data
validation?

If yes to above, can you handle this?

if not, does Table1 contain all of the projects?

If not, do any of the tables contain all of the projects? (If so which one?)

If not then do you need code to create a unique list of the projects for the
dropdown validation? (It is done by gathering the entire list from all tables
and then Advanced Filter to create a unique list.)

In the mean time I will do some testing. don't anticipate any difficulties.

--
Regards,

OssieMac


"primed" wrote:

Works fantastic.

Due to the fact that we cant trigger automatically, can we get user input to
choose the project number instead of using table 1. Will need an option to
show all projects.

Love your work.

"OssieMac" wrote:

I don't know of any way of triggering an event that will run the macro
automatically when the filter is applied to the first table. You will need to
provide a button to run the code.

The code permits custom filters with And/Or but it does not provide for
lists as can be filtered in xl2007.

The code assumes you have used the default table names of Table1, Table2,
Table3 etc otherwise it does not work in the loop.

Also assumes the tables are one under the other and not side by side because
when you filter entire rows are hidden; not just the row within the table.

Sub SetMatchingTableFilters()
Dim strHeader As String
Dim lngNumbTables As Long
Dim i As Long
Dim colNumber As Long
Dim rngHeader As Range
Dim varOperator As Variant
Dim varCriteria1 As Variant
Dim varCriteria2 As Variant

'Edit "Project" to your header name to find
strHeader = "Project"

'Edit 4 to the number of tables to process
lngNumbTables = 4

With ActiveSheet
'Find the Header name in the first table
Set rngHeader = .Range("Table1[#Headers]") _
.Find(What:=strHeader, _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

'If found then set the column number
'of the header
If Not rngHeader Is Nothing Then
colNumber = rngHeader.Column
Else
MsgBox "No column named 'Project' in table1."
Exit Sub
End If

'Save the filter criteria applied to
'Table1
With .ListObjects("Table1") _
.AutoFilter.Filters(colNumber)

If .On Then
Select Case .Operator
Case 0
varOperator = 0
varCriteria1 = .Criteria1
Case xlAnd
varOperator = xlAnd
varCriteria1 = .Criteria1
varCriteria2 = .Criteria2
Case xlOr
varOperator = xlOr
varCriteria1 = .Criteria1
varCriteria2 = .Criteria2
End Select
Else
MsgBox "No filter set on table1"
Exit Sub
End If
End With

'Iterate through remaining tables and
'find the header column number and
'then set the filters
For i = 2 To lngNumbTables

'Find the column header name
Set rngHeader = _
.Range("Table" & i & "[#Headers]") _
.Find(What:=strHeader, _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)

'If header name found then
'set the column header number
'(Column number in table is same
'as filter number)
If Not rngHeader Is Nothing Then
colNumber = rngHeader.Column
Else
MsgBox "No column named 'Project' in Table " & i
Exit Sub
End If

'Set the criteria for the filter number.
'Simple filter with one selection
If varOperator = 0 Then
.ListObjects("Table" & i) _
.Range.AutoFilter Field:=colNumber, _
Criteria1:=varCriteria1
Else
'If custom filter with And/Or operator
'used in filter.
.ListObjects("Table" & i) _
.Range.AutoFilter Field:=colNumber, _
Criteria1:=varCriteria1, _
Operator:=varOperator, _
Criteria2:=varCriteria2
End If
Next i

End With

End Sub

--
Regards,

OssieMac