Link to home
Start Free TrialLog in
Avatar of bfreescott
bfreescottFlag for United States of America

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
Avatar of zorvek (Kevin Jones)
zorvek (Kevin Jones)
Flag of United States of America image

Why are you repeatedly applying different criteria to the same column?

Kevin
Avatar of bfreescott

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
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
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
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.



SOLUTION
Avatar of Rory Archibald
Rory Archibald
Flag of United Kingdom of Great Britain and Northern Ireland image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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.Count - 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
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.Count - 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
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.
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
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.
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?
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?
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("Filter Criteria").[A:A].ClearContents
        ThisWorkbook.Sheets("Filter Criteria").[A1].Value = SRrange.Offset(0, 33).Value
        ThisWorkbook.Sheets("Filter Criteria").[A2].Resize(UBound(Values) + 1).Value = Application.Transpose(FilterValues)
        SRrange.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=ThisWorkbook.Sheets("Filter Criteria").[A1].Resize(UBound(FilterValues) + 2), Unique:=False
    End With

    Exit Sub
   
ErrorHandler:
    MsgBox "Error: " & Err.Number & " , " & Err.Description & Chr(13) & _
    "Procedure is: reg" & Chr(13) & ""

End Sub

Kevin
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(FilterValues) + 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?
ASKER CERTIFIED SOLUTION
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
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.
Which test? There are two.

Checked = srArray(arIndex) Or Checked

and

If Not Checked Then

Kevin
How is srArray defined?

Kevin
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.
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
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 guys!