bfreescott
asked on
Excel VBA Array within an Array
I am attempting to autofilter a set of records with an array, but the array is made up of other arrays. The filter won't work because it is looking for the value in the last array. I'm trying to filter on the values from the array within the last array. I know it's possible, but need a fresh set of eyes that aren't as tired as mine.
TIA!
Public Sub reg(brand As String, srArray1, srArray2, srArray3, srArray4, srArray5, srArray6)
'
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim i As Long
Dim SRrange As Range
Dim NE As Variant, MA As Variant, SE As Variant, CE As Variant, CW As Variant, WE As Variant
Dim SRConditions As Variant
If srArray1 = True Then
NE = VBA.Array("CT", "DE", "MA", "ME", "NH", "NJ", "NY", "PA", "RI", "VT")
Else: NE = ""
End If
If srArray2 = True Then
MA = VBA.Array("DC", "MD", "SE", "NC", "SC", "VA")
Else: MA = ""
End If
If srArray3 = True Then
SE = VBA.Array("FL", "GA", "SE", "MS", "PR", "TN", "VI")
Else: SE = ""
End If
If srArray4 = True Then
CE = VBA.Array("IN", "KY", "MI", "OH", "WV")
Else: CE = ""
End If
If srArray5 = True Then
CW = VBA.Array("IA", "IL", "MN", "MO", "ND", "SD", "WI")
Else: CW = ""
End If
If srArray6 = True Then
WE = VBA.Array("AK", "AR", "AZ", "CA", "CO", "HI", "ID", "KS", "LA", "MT", "NM", "NV", "OK", "OR", "TX", "UT", "WA", "WY")
Else: WE = ""
End If
SRConditions = VBA.Array(NE, MA, SE, CE, CW, WE)
'autofilter here with the passed brand variable sheet and subregions
With Sheets(brand)
Set SRrange = Range("A3").CurrentRegion
If .AutoFilterMode = True Then
.AutoFilterMode = False
For i = 0 To 5
SRrange.AutoFilter FIELD:=32, Criteria1:=SRConditions(i)
Next i
Else
For i = 0 To 5
SRrange.AutoFilter FIELD:=32, Criteria1:=SRConditions(i)
Next i
End If
End With
UserForm7.Hide
DoEvents
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Number & " , " & Err.Description & Chr(13) & _
"Procedure is: reg" & Chr(13) & ""
'
End Sub
TIA!
Public Sub reg(brand As String, srArray1, srArray2, srArray3, srArray4, srArray5, srArray6)
'
On Error GoTo ErrorHandler
Application.ScreenUpdating
Application.Calculation = xlCalculationManual
Dim i As Long
Dim SRrange As Range
Dim NE As Variant, MA As Variant, SE As Variant, CE As Variant, CW As Variant, WE As Variant
Dim SRConditions As Variant
If srArray1 = True Then
NE = VBA.Array("CT", "DE", "MA", "ME", "NH", "NJ", "NY", "PA", "RI", "VT")
Else: NE = ""
End If
If srArray2 = True Then
MA = VBA.Array("DC", "MD", "SE", "NC", "SC", "VA")
Else: MA = ""
End If
If srArray3 = True Then
SE = VBA.Array("FL", "GA", "SE", "MS", "PR", "TN", "VI")
Else: SE = ""
End If
If srArray4 = True Then
CE = VBA.Array("IN", "KY", "MI", "OH", "WV")
Else: CE = ""
End If
If srArray5 = True Then
CW = VBA.Array("IA", "IL", "MN", "MO", "ND", "SD", "WI")
Else: CW = ""
End If
If srArray6 = True Then
WE = VBA.Array("AK", "AR", "AZ", "CA", "CO", "HI", "ID", "KS", "LA", "MT", "NM", "NV", "OK", "OR", "TX", "UT", "WA", "WY")
Else: WE = ""
End If
SRConditions = VBA.Array(NE, MA, SE, CE, CW, WE)
'autofilter here with the passed brand variable sheet and subregions
With Sheets(brand)
Set SRrange = Range("A3").CurrentRegion
If .AutoFilterMode = True Then
.AutoFilterMode = False
For i = 0 To 5
SRrange.AutoFilter FIELD:=32, Criteria1:=SRConditions(i)
Next i
Else
For i = 0 To 5
SRrange.AutoFilter FIELD:=32, Criteria1:=SRConditions(i)
Next i
End If
End With
UserForm7.Hide
DoEvents
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Number & " , " & Err.Description & Chr(13) & _
"Procedure is: reg" & Chr(13) & ""
'
End Sub
ASKER
The criteria are set based on the user's selection on checkboxes which can be anywhere from 1-6. Each checkbox in turn represents an array of values that I want to filter on.
That explains a lot ;-)
Public Sub SetFilter(ByVal Brand As String, ByVal Selection As Long)
Dim SRrange As Range
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With Sheets(Brand)
Set SRrange = .Range("A3").CurrentRegion
If .AutoFilterMode = True Then .AutoFilterMode = False
Select Case Selection
Case 1
SRrange.AutoFilter FIELD:=32, Criteria1:=Array("CT", "DE", "MA", "ME", "NH", "NJ", "NY", "PA", "RI", "VT")
Case 2
SRrange.AutoFilter FIELD:=32, Criteria1:=Array("DC", "MD", "SE", "NC", "SC", "VA")
Case 3
SRrange.AutoFilter FIELD:=32, Criteria1:=Array("FL", "GA", "SE", "MS", "PR", "TN", "VI")
Case 4
SRrange.AutoFilter FIELD:=32, Criteria1:=Array("IN", "KY", "MI", "OH", "WV")
Case 5
SRrange.AutoFilter FIELD:=32, Criteria1:=Array("IA", "IL", "MN", "MO", "ND", "SD", "WI")
Case 6
SRrange.AutoFilter FIELD:=32, Criteria1:=Array("AK", "AR", "AZ", "CA", "CO", "HI", "ID", "KS", "LA", "MT", "NM", "NV", "OK", "OR", "TX", "UT", "WA", "WY")
End Select
End With
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Number & " , " & Err.Description & Chr(13) & _
"Procedure is: reg" & Chr(13) & ""
End Sub
Kevin
Public Sub SetFilter(ByVal Brand As String, ByVal Selection As Long)
Dim SRrange As Range
On Error GoTo ErrorHandler
Application.ScreenUpdating
Application.Calculation = xlCalculationManual
With Sheets(Brand)
Set SRrange = .Range("A3").CurrentRegion
If .AutoFilterMode = True Then .AutoFilterMode = False
Select Case Selection
Case 1
SRrange.AutoFilter FIELD:=32, Criteria1:=Array("CT", "DE", "MA", "ME", "NH", "NJ", "NY", "PA", "RI", "VT")
Case 2
SRrange.AutoFilter FIELD:=32, Criteria1:=Array("DC", "MD", "SE", "NC", "SC", "VA")
Case 3
SRrange.AutoFilter FIELD:=32, Criteria1:=Array("FL", "GA", "SE", "MS", "PR", "TN", "VI")
Case 4
SRrange.AutoFilter FIELD:=32, Criteria1:=Array("IN", "KY", "MI", "OH", "WV")
Case 5
SRrange.AutoFilter FIELD:=32, Criteria1:=Array("IA", "IL", "MN", "MO", "ND", "SD", "WI")
Case 6
SRrange.AutoFilter FIELD:=32, Criteria1:=Array("AK", "AR", "AZ", "CA", "CO", "HI", "ID", "KS", "LA", "MT", "NM", "NV", "OK", "OR", "TX", "UT", "WA", "WY")
End Select
End With
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Number & " , " & Err.Description & Chr(13) & _
"Procedure is: reg" & Chr(13) & ""
End Sub
Kevin
Note that I changed the parameter structure from six booleans to a single long. Pass the selection as a single integer with a value of 1 to 6.
Kevin
Kevin
I get the impression the idea was to be able to combine multiple arrays into one criteria array and then apply that.
What? We're supposed to read the question and comments? When did that start?
I think it's a new policy they're trying out... :)
All pretty now:
Public Sub reg(brand As String, srArray1, srArray2, srArray3, srArray4, srArray5, srArray6)
Dim SRrange As Range
Dim FilterValues As Variant
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
FilterValues = Array()
If srArray1 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("CT", "DE", "MA", "ME", "NH", "NJ", "NY", "PA", "RI", "VT")))
If srArray2 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("DC", "MD", "SE", "NC", "SC", "VA")))
If srArray3 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("FL", "GA", "SE", "MS", "PR", "TN", "VI")))
If srArray4 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("IN", "KY", "MI", "OH", "WV")))
If srArray5 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("IA", "IL", "MN", "MO", "ND", "SD", "WI")))
If srArray6 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("AK", "AR", "AZ", "CA", "CO", "HI", "ID", "KS", "LA", "MT", "NM", "NV", "OK", "OR", "TX", "UT", "WA", "WY")))
With Sheets(brand)
Set SRrange = .Range("A3").CurrentRegion
If .AutoFilterMode = True Then .AutoFilterMode = False
SRrange.AutoFilter FIELD:=32, Criteria1:=FilterValues
End With
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Number & " , " & Err.Description & Chr(13) & _
"Procedure is: reg" & Chr(13) & ""
End Sub
Kevin
Public Sub reg(brand As String, srArray1, srArray2, srArray3, srArray4, srArray5, srArray6)
Dim SRrange As Range
Dim FilterValues As Variant
On Error GoTo ErrorHandler
Application.ScreenUpdating
Application.Calculation = xlCalculationManual
FilterValues = Array()
If srArray1 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("CT", "DE", "MA", "ME", "NH", "NJ", "NY", "PA", "RI", "VT")))
If srArray2 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("DC", "MD", "SE", "NC", "SC", "VA")))
If srArray3 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("FL", "GA", "SE", "MS", "PR", "TN", "VI")))
If srArray4 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("IN", "KY", "MI", "OH", "WV")))
If srArray5 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("IA", "IL", "MN", "MO", "ND", "SD", "WI")))
If srArray6 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("AK", "AR", "AZ", "CA", "CO", "HI", "ID", "KS", "LA", "MT", "NM", "NV", "OK", "OR", "TX", "UT", "WA", "WY")))
With Sheets(brand)
Set SRrange = .Range("A3").CurrentRegion
If .AutoFilterMode = True Then .AutoFilterMode = False
SRrange.AutoFilter FIELD:=32, Criteria1:=FilterValues
End With
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Number & " , " & Err.Description & Chr(13) & _
"Procedure is: reg" & Chr(13) & ""
End Sub
Kevin
ASKER
Thanks Kevin - looks like a nice piece of work here. Problem is when I tried it, the filter got rid of everything, same as my original proc. I figured out 2 things that were happening:
1) My autofilter was set to filter on field 32, which should have been 33, so #$&%*(#&$%*(@&.
I don't like the fact that I have a number there anyway when I know I should be using a named range, but I digress.
2) When I corrected the Field number, the filter only returned records if there was a match on the last value in the array. e.g. for srArray1, records that matched "VT"
It appears that the proc is refiltering with each array value.
If srArray1 =True, then I want to see every records that matches ANY of the values in the srArray1 array.
1) My autofilter was set to filter on field 32, which should have been 33, so #$&%*(#&$%*(@&.
I don't like the fact that I have a number there anyway when I know I should be using a named range, but I digress.
2) When I corrected the Field number, the filter only returned records if there was a match on the last value in the array. e.g. for srArray1, records that matched "VT"
It appears that the proc is refiltering with each array value.
If srArray1 =True, then I want to see every records that matches ANY of the values in the srArray1 array.
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Or a helper column. In this version I use the column to the right of 33 to insert a formula which returns a Boolean which is in turn used to do the autofiltering.
Public Sub reg(brand As String, srArray1, srArray2, srArray3, srArray4, srArray5, srArray6)
Dim SRrange As Range
Dim FilterValues As Variant
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
FilterValues = Array()
If srArray1 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("CT", "DE", "MA", "ME", "NH", "NJ", "NY", "PA", "RI", "VT")))
If srArray2 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("DC", "MD", "SE", "NC", "SC", "VA")))
If srArray3 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("FL", "GA", "SE", "MS", "PR", "TN", "VI")))
If srArray4 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("IN", "KY", "MI", "OH", "WV")))
If srArray5 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("IA", "IL", "MN", "MO", "ND", "SD", "WI")))
If srArray6 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("AK", "AR", "AZ", "CA", "CO", "HI", "ID", "KS", "LA", "MT", "NM", "NV", "OK", "OR", "TX", "UT", "WA", "WY")))
With Sheets(brand)
Set SRrange = .Range("A3").CurrentRegion
sRange.Offset(1, 33).Resize(sRange.Rows.Cou nt - 1).Formula = "=NOT(ISERROR(MATCH(" & sRange.Offset(1, 33).Resize(1, 1).Address & ",{""" & Join(FilterValues, """,""") & """},0)))"
If .AutoFilterMode = True Then .AutoFilterMode = False
SRrange.AutoFilter FIELD:=33, Criteria1:=True
End With
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Number & " , " & Err.Description & Chr(13) & _
"Procedure is: reg" & Chr(13) & ""
End Sub
Kevin
Public Sub reg(brand As String, srArray1, srArray2, srArray3, srArray4, srArray5, srArray6)
Dim SRrange As Range
Dim FilterValues As Variant
On Error GoTo ErrorHandler
Application.ScreenUpdating
Application.Calculation = xlCalculationManual
FilterValues = Array()
If srArray1 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("CT", "DE", "MA", "ME", "NH", "NJ", "NY", "PA", "RI", "VT")))
If srArray2 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("DC", "MD", "SE", "NC", "SC", "VA")))
If srArray3 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("FL", "GA", "SE", "MS", "PR", "TN", "VI")))
If srArray4 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("IN", "KY", "MI", "OH", "WV")))
If srArray5 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("IA", "IL", "MN", "MO", "ND", "SD", "WI")))
If srArray6 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("AK", "AR", "AZ", "CA", "CO", "HI", "ID", "KS", "LA", "MT", "NM", "NV", "OK", "OR", "TX", "UT", "WA", "WY")))
With Sheets(brand)
Set SRrange = .Range("A3").CurrentRegion
sRange.Offset(1, 33).Resize(sRange.Rows.Cou
If .AutoFilterMode = True Then .AutoFilterMode = False
SRrange.AutoFilter FIELD:=33, Criteria1:=True
End With
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Number & " , " & Err.Description & Chr(13) & _
"Procedure is: reg" & Chr(13) & ""
End Sub
Kevin
Fixed bugs:
Public Sub reg(brand As String, srArray1, srArray2, srArray3, srArray4, srArray5, srArray6)
Dim SRrange As Range
Dim FilterValues As Variant
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
FilterValues = Array()
If srArray1 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("CT", "DE", "MA", "ME", "NH", "NJ", "NY", "PA", "RI", "VT")))
If srArray2 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("DC", "MD", "SE", "NC", "SC", "VA")))
If srArray3 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("FL", "GA", "SE", "MS", "PR", "TN", "VI")))
If srArray4 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("IN", "KY", "MI", "OH", "WV")))
If srArray5 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("IA", "IL", "MN", "MO", "ND", "SD", "WI")))
If srArray6 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("AK", "AR", "AZ", "CA", "CO", "HI", "ID", "KS", "LA", "MT", "NM", "NV", "OK", "OR", "TX", "UT", "WA", "WY")))
With Sheets(brand)
Set SRrange = .Range("A3").CurrentRegion
SRrange.Offset(1, 33).Resize(SRrange.Rows.Co unt - 1, 1).Formula = "=NOT(ISERROR(MATCH(" & SRrange.Offset(1, 32).Resize(1, 1).Address(False, False) & ",{""" & Join(FilterValues, """,""") & """},0)))"
If .AutoFilterMode = True Then .AutoFilterMode = False
SRrange.AutoFilter Field:=34, Criteria1:=True
End With
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Number & " , " & Err.Description & Chr(13) & _
"Procedure is: reg" & Chr(13) & ""
End Sub
Kevin
Public Sub reg(brand As String, srArray1, srArray2, srArray3, srArray4, srArray5, srArray6)
Dim SRrange As Range
Dim FilterValues As Variant
On Error GoTo ErrorHandler
Application.ScreenUpdating
Application.Calculation = xlCalculationManual
FilterValues = Array()
If srArray1 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("CT", "DE", "MA", "ME", "NH", "NJ", "NY", "PA", "RI", "VT")))
If srArray2 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("DC", "MD", "SE", "NC", "SC", "VA")))
If srArray3 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("FL", "GA", "SE", "MS", "PR", "TN", "VI")))
If srArray4 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("IN", "KY", "MI", "OH", "WV")))
If srArray5 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("IA", "IL", "MN", "MO", "ND", "SD", "WI")))
If srArray6 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("AK", "AR", "AZ", "CA", "CO", "HI", "ID", "KS", "LA", "MT", "NM", "NV", "OK", "OR", "TX", "UT", "WA", "WY")))
With Sheets(brand)
Set SRrange = .Range("A3").CurrentRegion
SRrange.Offset(1, 33).Resize(SRrange.Rows.Co
If .AutoFilterMode = True Then .AutoFilterMode = False
SRrange.AutoFilter Field:=34, Criteria1:=True
End With
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Number & " , " & Err.Description & Chr(13) & _
"Procedure is: reg" & Chr(13) & ""
End Sub
Kevin
ASKER
I am using a pre-2007 version (not by choice), so maybe I do need to use an advanced filter.
Any thoughts on what that proc would look like?
I think you have to use a sheet range filled with criteria in order to use the advanced filter and I would rather pass the criteria to the filter.
Also, I don't want to enter any additional columns; that would introduce a whole new issue with my dataset.
Any thoughts on what that proc would look like?
I think you have to use a sheet range filled with criteria in order to use the advanced filter and I would rather pass the criteria to the filter.
Also, I don't want to enter any additional columns; that would introduce a whole new issue with my dataset.
You can't use the advanced filter function without also defining a range of cells to hold the selection criteria.
Why can't you add a help column? You can hide the column so the user can't see it.
Kevin
Why can't you add a help column? You can hide the column so the user can't see it.
Kevin
ASKER
The whole point of trying to do it in code was to avoid creating yet another column in an already large dataset. I actually have an existing procedure that creates a new column and fills it with the appropriate values (see above arrays) based on Field33, but I'm not sure I really want to do that. Maybe you can convince me. (In my experience, users don't like to scroll to BFE - an actual column in 2007 - lol)
This is all part of the larger project of creating a "code template" that allows different users to create UDFs with the same data based on their unique requirements. This view is a solution to one user's UDF requirement.
This is all part of the larger project of creating a "code template" that allows different users to create UDFs with the same data based on their unique requirements. This view is a solution to one user's UDF requirement.
Although you do need to use a criteria range to use advanced filter (you cannot simply pass the criteria directly), the range can be on a separate hidden sheet if that is acceptable?
ASKER
How about this: best of both worlds?
Can I use the code Kevin put together with FilterValues=Array() to create the AdvancedFilter criteria range on a sheet?
Can I use the code Kevin put together with FilterValues=Array() to create the AdvancedFilter criteria range on a sheet?
Add a new worksheet. Assuming the tab name is "Filter Criteria" then:
Public Sub reg(brand As String, srArray1, srArray2, srArray3, srArray4, srArray5, srArray6)
Dim SRrange As Range
Dim FilterValues As Variant
On Error GoTo ErrorHandler
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
FilterValues = Array()
If srArray1 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("CT", "DE", "MA", "ME", "NH", "NJ", "NY", "PA", "RI", "VT")))
If srArray2 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("DC", "MD", "SE", "NC", "SC", "VA")))
If srArray3 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("FL", "GA", "SE", "MS", "PR", "TN", "VI")))
If srArray4 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("IN", "KY", "MI", "OH", "WV")))
If srArray5 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("IA", "IL", "MN", "MO", "ND", "SD", "WI")))
If srArray6 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("AK", "AR", "AZ", "CA", "CO", "HI", "ID", "KS", "LA", "MT", "NM", "NV", "OK", "OR", "TX", "UT", "WA", "WY")))
With Sheets(brand)
Set SRrange = .Range("A3").CurrentRegion
ThisWorkbook.Sheets("Filte r Criteria").[A:A].ClearCont ents
ThisWorkbook.Sheets("Filte r Criteria").[A1].Value = SRrange.Offset(0, 33).Value
ThisWorkbook.Sheets("Filte r Criteria").[A2].Resize(UBo und(Values ) + 1).Value = Application.Transpose(Filt erValues)
SRrange.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=ThisWorkboo k.Sheets(" Filter Criteria").[A1].Resize(UBo und(Filter Values) + 2), Unique:=False
End With
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Number & " , " & Err.Description & Chr(13) & _
"Procedure is: reg" & Chr(13) & ""
End Sub
Kevin
Public Sub reg(brand As String, srArray1, srArray2, srArray3, srArray4, srArray5, srArray6)
Dim SRrange As Range
Dim FilterValues As Variant
On Error GoTo ErrorHandler
Application.ScreenUpdating
Application.Calculation = xlCalculationManual
FilterValues = Array()
If srArray1 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("CT", "DE", "MA", "ME", "NH", "NJ", "NY", "PA", "RI", "VT")))
If srArray2 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("DC", "MD", "SE", "NC", "SC", "VA")))
If srArray3 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("FL", "GA", "SE", "MS", "PR", "TN", "VI")))
If srArray4 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("IN", "KY", "MI", "OH", "WV")))
If srArray5 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("IA", "IL", "MN", "MO", "ND", "SD", "WI")))
If srArray6 Then FilterValues = Split(Join(FilterValues) & IIf(UBound(FilterValues) > -1, " ", vbNullString) & Join(Array("AK", "AR", "AZ", "CA", "CO", "HI", "ID", "KS", "LA", "MT", "NM", "NV", "OK", "OR", "TX", "UT", "WA", "WY")))
With Sheets(brand)
Set SRrange = .Range("A3").CurrentRegion
ThisWorkbook.Sheets("Filte
ThisWorkbook.Sheets("Filte
ThisWorkbook.Sheets("Filte
SRrange.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=ThisWorkboo
End With
Exit Sub
ErrorHandler:
MsgBox "Error: " & Err.Number & " , " & Err.Description & Chr(13) & _
"Procedure is: reg" & Chr(13) & ""
End Sub
Kevin
ASKER
Kevin,
We're just about finished here. I've adjusted 2 lines of your above code:
"SRrange.Offset(0, 33).Value" should be "SRrange.Offset(0, 32).Value" in order to select Col 33.
"Resize(UBound(Values) + 1)" should be "Resize(UBound(FilterValue s) + 1)"
One more question before some well-deserved points:
I need to catch the accidental (or intentional) omission of ALL checkboxes which set the srArray booleans. Here is the code I am using to loop through the checkboxes:
For arIndex = 1 To 6
srArray(arIndex) = Me.Controls("CheckBox" & arIndex).Value
Next
Any ideas on what would need to be added?
We're just about finished here. I've adjusted 2 lines of your above code:
"SRrange.Offset(0, 33).Value" should be "SRrange.Offset(0, 32).Value" in order to select Col 33.
"Resize(UBound(Values) + 1)" should be "Resize(UBound(FilterValue
One more question before some well-deserved points:
I need to catch the accidental (or intentional) omission of ALL checkboxes which set the srArray booleans. Here is the code I am using to loop through the checkboxes:
For arIndex = 1 To 6
srArray(arIndex) = Me.Controls("CheckBox" & arIndex).Value
Next
Any ideas on what would need to be added?
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Kevin,
This is just giving me a type mismatch.
I actually did the same thing as you at the bottom before I asked the question.
It's the test part that is causing the problem for both of our solutions.
This is just giving me a type mismatch.
I actually did the same thing as you at the bottom before I asked the question.
It's the test part that is causing the problem for both of our solutions.
Which test? There are two.
Checked = srArray(arIndex) Or Checked
and
If Not Checked Then
Kevin
Checked = srArray(arIndex) Or Checked
and
If Not Checked Then
Kevin
How is srArray defined?
Kevin
Kevin
ASKER
srArray is a boolean
I believe it's erroring out on 'If Not Checked Then' but I would have to go back and step through it to be sure.
I believe it's erroring out on 'If Not Checked Then' but I would have to go back and step through it to be sure.
It can't be. Checked is a boolean and thus will be either True or False and will never generate a type mismatch.
Something else is amiss.
Please post the entire routine. More points too ;-)
Kevin
Something else is amiss.
Please post the entire routine. More points too ;-)
Kevin
ASKER
Ok Kevin, I think we've got it. I had changed your boolean Checked because I didn't like the use of that word as a variable. In .NET, checkbox.value becomes checkbox.checked, so I didn't want to get confused when I eventually port this to .NET.
Thanks for your help on this; I did up the points, in part because I want to give some credit to Rorya for recognizing that I was pre-2007 and needed to use the Advanced Filter (even though I didn't want to use it).
I will probably continue to work this proc, but I'll close the question anyway as the solution provided meets my current needs. Thanks again!
Thanks for your help on this; I did up the points, in part because I want to give some credit to Rorya for recognizing that I was pre-2007 and needed to use the Advanced Filter (even though I didn't want to use it).
I will probably continue to work this proc, but I'll close the question anyway as the solution provided meets my current needs. Thanks again!
ASKER
Thanks guys!
Kevin