Table Filters

[primed]

Hi I have 7 tables on one sheet. Each table has a column called "PROJECT".
When i apply a filter to table 1 how do i automatically apply the same filter
to the other tables. The filter applied will be to choose a project number
from 1 to 10.

Thanks in Advance.

 

[OssieMac]

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

 

[primed]

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.

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

 

[OssieMac]

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

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.

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

 

[primed]

Hi,
No to data validation.
Yes Table 1 holds all the project numbers, but will hold multiple instances
of all the project numbers. It would be fine to presume there will be 10
projects. If i need more, i can edit the code.

Thanks for your help.

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

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.

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

 

[OssieMac]

"No to data validation" Then I need to know how you want to select the
project number and how you want to trigger the macro. Also need to know where
to get the filter value to use in the code.


--
Regards,

OssieMac

Hi,
No to data validation.
Yes Table 1 holds all the project numbers, but will hold multiple instances
of all the project numbers. It would be fine to presume there will be 10
projects. If i need more, i can edit the code.

Thanks for your help.

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

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.

:

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

 

[primed]

Select the project number through a popup message that gives you the option
of selecting project 1,2,3,4,5,6,7,8,9,10 or all. On close activate the code
to filter the tables to match the chosen project. I'll attach the popup to a
button on the page.

Regards

"No to data validation" Then I need to know how you want to select the
project number and how you want to trigger the macro. Also need to know where
to get the filter value to use in the code.


--
Regards,

OssieMac

Hi,
No to data validation.
Yes Table 1 holds all the project numbers, but will hold multiple instances
of all the project numbers. It would be fine to presume there will be 10
projects. If i need more, i can edit the code.

Thanks for your help.

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


:

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.

:

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

 

[OssieMac]

Suggest that you backup your workbook and don't get rid of the previous code
before you test this code.

OK I have come up with the following. It creates a unique and sorted array
of the values in the Project column of Table1 to use with the Prompt in the
popup InputBox.

The Project column range is dynamic so if you add or delete rows in Table1
then the valid list should still be accurate. See end of this post for some
more info on populating a combo box with the array which I added just for
info in case you want it.

Note that there are 2 subs. The sub to populate the array is called from the
main sub. Also note the comments.

This code only does simple one criteria filters. There is no provision for
the And/Or operators and second criteria as was in my previous post.

Watch this post for a code updates. I believe there is a better way of
getting the column number of the "Project" column but for some reason it
works sometimes then I get some error about it becoming detatched. Will
continue to test and see if I can find the answer.

'Following Dim statement must be
'in declarations area at top of code
Dim validArray()

Sub SetMatchingTableFilters()
Dim strHeader As String
Dim lngNumbTables As Long
Dim i As Long
Dim colNumber As Long
Dim rngHeader As Range
Dim varInitCriteria As Variant
Dim varInputs As Variant

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

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

Call UniqueArray

For i = LBound(validArray) To UBound(validArray)
varInputs = varInputs & validArray(i) & ", "
Next i

varInputs = varInputs & "All"

'Do loop anly allows valid input.
Do
varInitCriteria = Application.InputBox _
(Prompt:="Enter the required project number." _
& vbCrLf & vbCrLf & "Valid inputs " & varInputs, _
Title:="Project Number")
Loop While InStr(1, UCase(varInputs), _
UCase(varInitCriteria)) = 0

With ActiveSheet
'Iterate through all tables and
'find the header column number and
'then set the filters
For i = 1 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 " & _
strHeader & " in Table" & i
Exit Sub
End If

'Set the criteria for the filter number.
'Simple filter with one selection.
If UCase(varInitCriteria) = "ALL" Then
.ListObjects("Table" & i) _
.Range.AutoFilter Field:=colNumber
Else
.ListObjects("Table" & i) _
.Range.AutoFilter Field:=colNumber, _
Criteria1:=varInitCriteria
End If
Next i

End With
End Sub

Sub UniqueArray()
'Creates an array with a unique and sorted _
list of the projects in Table 1.
'Called from SetMatchingTableFilters.
'Used to create a variable for the _
InputBox Prompt message and to validate _
the Inputbox entry.

Dim initArray
Dim i
Dim j
Dim temp

With Range("Table1[[#All],[Project]]")
initArray = .Offset(1, 0) _
.Resize(.Rows.Count - 1, 1).Value
End With

'Sort the array
For i = LBound(initArray) To UBound(initArray) - 1
For j = LBound(initArray) To UBound(initArray) - 1
If initArray(j, 1) > initArray(j + 1, 1) Then
temp = initArray(j, 1)
initArray(j, 1) = initArray(j + 1, 1)
initArray(j + 1, 1) = temp
End If
Next j
Next i

'Following copies unique elements to new array.
j = 1
'Redim using 1 to j starts array at 1 instead of
'zero and makes it easier to code.
ReDim validArray(1 To j)
'Copy first element of initArray to validArray
validArray(j) = initArray(j, 1)

For i = LBound(initArray) + 1 To UBound(initArray)
If initArray(i, 1) <> validArray(j) Then
j = j + 1
ReDim Preserve validArray(1 To j)
validArray(j) = initArray(i, 1)
End If
Next i

'Test validArray contents
'Leave commented out unless testing required
'For i = LBound(validArray) To UBound(validArray)
'MsgBox validArray(i)
'Next i
End Sub


'*********************************
Could use the following code to populate a combobox. However, you would need
a button to run it then select from the combo box. It calls the UniqueArray
sub above to create the unique array before populating the combobox.

Sub ComboBoxPopulate()
'Sample code to populate a combo box from the array
Dim i
Dim varInitCriteria

Call UniqueArray

With ActiveSheet.OLEObjects _
("Combobox1").Object

.Clear
For i = LBound(validArray) _
To UBound(validArray)
.AddItem validArray(i)
Next i
.AddItem "All"
End With

End Sub

 

[primed]

Nice work.

Couple of small issues
When I enter "total" in the popup message the value on the spreadsheet comes
out at 0, due to the total row in each table being a subtotal formula. ie if
no rows displayed in the table the table total is 0. Any ideas how to fix?

and

The cancel button on the popup doesnt work.

Regards

Suggest that you backup your workbook and don't get rid of the previous code
before you test this code.

OK I have come up with the following. It creates a unique and sorted array
of the values in the Project column of Table1 to use with the Prompt in the
popup InputBox.

The Project column range is dynamic so if you add or delete rows in Table1
then the valid list should still be accurate. See end of this post for some
more info on populating a combo box with the array which I added just for
info in case you want it.

Note that there are 2 subs. The sub to populate the array is called from the
main sub. Also note the comments.

This code only does simple one criteria filters. There is no provision for
the And/Or operators and second criteria as was in my previous post.

Watch this post for a code updates. I believe there is a better way of
getting the column number of the "Project" column but for some reason it
works sometimes then I get some error about it becoming detatched. Will
continue to test and see if I can find the answer.

'Following Dim statement must be
'in declarations area at top of code
Dim validArray()

Sub SetMatchingTableFilters()
Dim strHeader As String
Dim lngNumbTables As Long
Dim i As Long
Dim colNumber As Long
Dim rngHeader As Range
Dim varInitCriteria As Variant
Dim varInputs As Variant

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

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

Call UniqueArray

For i = LBound(validArray) To UBound(validArray)
varInputs = varInputs & validArray(i) & ", "
Next i

varInputs = varInputs & "All"

'Do loop anly allows valid input.
Do
varInitCriteria = Application.InputBox _
(Prompt:="Enter the required project number." _
& vbCrLf & vbCrLf & "Valid inputs " & varInputs, _
Title:="Project Number")
Loop While InStr(1, UCase(varInputs), _
UCase(varInitCriteria)) = 0

With ActiveSheet
'Iterate through all tables and
'find the header column number and
'then set the filters
For i = 1 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 " & _
strHeader & " in Table" & i
Exit Sub
End If

'Set the criteria for the filter number.
'Simple filter with one selection.
If UCase(varInitCriteria) = "ALL" Then
.ListObjects("Table" & i) _
.Range.AutoFilter Field:=colNumber
Else
.ListObjects("Table" & i) _
.Range.AutoFilter Field:=colNumber, _
Criteria1:=varInitCriteria
End If
Next i

End With
End Sub

Sub UniqueArray()
'Creates an array with a unique and sorted _
list of the projects in Table 1.
'Called from SetMatchingTableFilters.
'Used to create a variable for the _
InputBox Prompt message and to validate _
the Inputbox entry.

Dim initArray
Dim i
Dim j
Dim temp

With Range("Table1[[#All],[Project]]")
initArray = .Offset(1, 0) _
.Resize(.Rows.Count - 1, 1).Value
End With

'Sort the array
For i = LBound(initArray) To UBound(initArray) - 1
For j = LBound(initArray) To UBound(initArray) - 1
If initArray(j, 1) > initArray(j + 1, 1) Then
temp = initArray(j, 1)
initArray(j, 1) = initArray(j + 1, 1)
initArray(j + 1, 1) = temp
End If
Next j
Next i

'Following copies unique elements to new array.
j = 1
'Redim using 1 to j starts array at 1 instead of
'zero and makes it easier to code.
ReDim validArray(1 To j)
'Copy first element of initArray to validArray
validArray(j) = initArray(j, 1)

For i = LBound(initArray) + 1 To UBound(initArray)
If initArray(i, 1) <> validArray(j) Then
j = j + 1
ReDim Preserve validArray(1 To j)
validArray(j) = initArray(i, 1)
End If
Next i

'Test validArray contents
'Leave commented out unless testing required
'For i = LBound(validArray) To UBound(validArray)
'MsgBox validArray(i)
'Next i
End Sub


'*********************************
Could use the following code to populate a combobox. However, you would need
a button to run it then select from the combo box. It calls the UniqueArray
sub above to create the unique array before populating the combobox.

Sub ComboBoxPopulate()
'Sample code to populate a combo box from the array
Dim i
Dim varInitCriteria

Call UniqueArray

With ActiveSheet.OLEObjects _
("Combobox1").Object

.Clear
For i = LBound(validArray) _
To UBound(validArray)
.AddItem validArray(i)
Next i
.AddItem "All"
End With

End Sub

 

[OssieMac]

OK in the 'Do/Loop While' section if you add the code between the asterisk
lines for a bit more validation. Tests for Cancel and also if user clicks OK
without entering anything. However, if user enters Al (or A or L) instead of
'All' then the validation does not capture it and the Instr function in the
Loop While sees it as valid and the filters are set to nothing. Could
possibly be validated by using a loop and individually comparing against each
element of the array but is it worth it?

Your other problem with Total. Not sure that I am interpreting your question
correctly but I assume that you do not want Total to be an option which is
reasonable considering what SubTotal function does. (I didn't consider it
initially because I did not have totals in my test tables but now I have
added them.)

Therefore in the Sub UniqueArray() replace the code that assigns the range
to the array so that the Resize reduces by - 2 rows instead of reduce by - 1
row.

With Range("Table1[[#All],[Project]]")
initArray = .Offset(1, 0) _
.Resize(.Rows.Count - 2, 1).Value
End With

 

[OssieMac]

I forgot to copy in the code between the asterisk lines for the first part.

Do
varInitCriteria = Application.InputBox _
(Prompt:="Enter the required project number." _
& vbCrLf & vbCrLf & "Valid inputs " & varInputs, _
Title:="Project Number")

'*******************************************
If varInitCriteria = False _
Or Len(varInitCriteria) = 0 Then
MsgBox "User Cancelled " & _
"or did not make a selection." & vbCrLf & _
vbCrLf & "Processing terminated."
Exit Sub
End If
'*******************************************

Loop While InStr(1, UCase(varInputs), _
UCase(varInitCriteria)) = 0

 

[primed]

Cheers,

Happy with the way it works.
Thanks for your help and promptness.

Regards
Primed

 

[primed]

Hi again,

I need to output the user input from the popup box into a cell on the
spreadsheet so i can do some additional sumif formulas. How do i alter your
code to do that.

Regards
Primed.