OssieMac said: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 said: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 said: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 said: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 said: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 said: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 said: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.
OssieMac said: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 said: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 said:"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
primed said: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.
OssieMac said: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 said: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
Want to reply to this thread or ask your own question?
You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.