Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
OssieMac help with code.
Immediately after the following line
Loop While InStr(1, UCase(varInputs), _ UCase(varInitCriteria)) = 0 insert the following line but edit "Sheet1" to your sheet name. Sheets("Sheet1").Range("A") = varInitCriteria -- Regards, OssieMac "primed" wrote: 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
OssieMac help with code.
My apologies that should have been Range("A1") not A
Sheets("Sheet1").Range("A1") = varInitCriteria -- Regards, OssieMac "OssieMac" wrote: Immediately after the following line Loop While InStr(1, UCase(varInputs), _ UCase(varInitCriteria)) = 0 insert the following line but edit "Sheet1" to your sheet name. Sheets("Sheet1").Range("A") = varInitCriteria -- Regards, OssieMac "primed" wrote: 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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
OssieMac help with code.
Cheers, I just had to change "A" to "A1"
"OssieMac" wrote: Immediately after the following line Loop While InStr(1, UCase(varInputs), _ UCase(varInitCriteria)) = 0 insert the following line but edit "Sheet1" to your sheet name. Sheets("Sheet1").Range("A") = varInitCriteria -- Regards, OssieMac "primed" wrote: 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Creating excel file, adding code to it from code, VBE window stays | Excel Programming | |||
How can I modify my code to offset the defined range and repeat theprocedure instead of duplicating my code? | Excel Programming | |||
Run VBA code only worksheet change, but don't trigger worksheet_change event based on what the code does | Excel Programming | |||
Shorten code to apply to all sheets except a few, instead of individually naming them, and later adding to code. | Excel Programming | |||
Excel code convert to Access code - Concat & eliminate duplicates | Excel Programming |