View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
primed primed is offline
external usenet poster
 
Posts: 23
Default OssieMac help with code.

Hi,

Thanks again for the code below.
Can you please provide one small alteration. I now need the users input that
is entered into the poup box to be copied into a cell on the same page. Ie if
the user chooses 1 then 1 is then displayed in cell A1. If they select All
then "All" is displayed in cell A1.

Cheers
Primed

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 8 to the number total number of tables to process
lngNumbTables = 8

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")

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

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