[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 971
  • Last Modified:

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
0
bfreescott
Asked:
bfreescott
  • 13
  • 10
  • 4
2 Solutions
 
zorvek (Kevin Jones)ConsultantCommented:
Why are you repeatedly applying different criteria to the same column?

Kevin
0
 
bfreescottAuthor Commented:
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.
0
 
zorvek (Kevin Jones)ConsultantCommented:
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
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
zorvek (Kevin Jones)ConsultantCommented:
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
0
 
Rory ArchibaldCommented:
I get the impression the idea was to be able to combine multiple arrays into one criteria array and then apply that.
0
 
zorvek (Kevin Jones)ConsultantCommented:
What? We're supposed to read the question and comments? When did that start?
0
 
Rory ArchibaldCommented:
I think it's a new policy they're trying out... :)
0
 
zorvek (Kevin Jones)ConsultantCommented:
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
0
 
bfreescottAuthor Commented:
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.



0
 
Rory ArchibaldCommented:
Which version of Excel are you using? If it's pre 2007, I think you'll need an advanced filter.
0
 
zorvek (Kevin Jones)ConsultantCommented:
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
0
 
zorvek (Kevin Jones)ConsultantCommented:
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
0
 
bfreescottAuthor Commented:
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.
0
 
zorvek (Kevin Jones)ConsultantCommented:
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
0
 
bfreescottAuthor Commented:
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.
0
 
Rory ArchibaldCommented:
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?
0
 
bfreescottAuthor Commented:
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?
0
 
zorvek (Kevin Jones)ConsultantCommented:
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
0
 
bfreescottAuthor Commented:
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?
0
 
zorvek (Kevin Jones)ConsultantCommented:
Me thinks if no check boxes are checked then you show all:

        Dim Checked As Boolean
        For arIndex = 1 To 6
            srArray(arIndex) = Me.Controls("CheckBox" & arIndex).Value
            Checked = srArray(arIndex) Or Checked
        Next
        If Not Checked Then
            For arIndex = 1 To 6
                srArray(arIndex) = True
            Next
        End If

Kevin
0
 
bfreescottAuthor Commented:
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.
0
 
zorvek (Kevin Jones)ConsultantCommented:
Which test? There are two.

Checked = srArray(arIndex) Or Checked

and

If Not Checked Then

Kevin
0
 
zorvek (Kevin Jones)ConsultantCommented:
How is srArray defined?

Kevin
0
 
bfreescottAuthor Commented:
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.
0
 
zorvek (Kevin Jones)ConsultantCommented:
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
0
 
bfreescottAuthor Commented:
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!
0
 
bfreescottAuthor Commented:
Thanks guys!
0

Featured Post

Important Lessons on Recovering from Petya

In their most recent webinar, Skyport Systems explores ways to isolate and protect critical databases to keep the core of your company safe from harm.

  • 13
  • 10
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now