Multi-Select Listbox output to use for Worksheet Autofilter 2

[darvistor]

Hello all,

I did some searches for this issue and there are some variations, but I can't seem to find my same issue. I am using Excel 2010 and have written/tweaked VBA code for a while now. I have a userform I created with 2 multi-select listboxes and 3 textboxes. The goal of my userform is to allow the user to input a start and end date for a record search, select one or more products from a list, select one or more record states from a list, make a copy of a worksheet, have it renamed, and finally filter the worksheet based on the selections from the userform.

The date filter, worksheet rename and copy all works fine. The issue I am currently having is getting the selections from the two listboxes in the proper format to use for the autofilter.

This is part of the code I used associated with the date filter. This part works great as there are never more than two selections for the date filter.

Dim StartDate As Date
    Dim EndDate As Date
    
    Range("C1").Select
    Selection.AutoFilter
    ActiveSheet.Range("$A$1:$AT$2000").AutoFilter Field:=2, Criteria1:= _
        ">=" & StartDate, Operator:=xlAnd, Criteria2:="<=" & EndDate

I recorded a macro of me selecting 3 choices in my product list box and the result is the following

    ActiveSheet.Range("$A$1:$AT$2000").AutoFilter Field:=5, Criteria1:=Array( _
        "Selection1", "Selection2", "Selection3"), Operator:=xlFilterValues

I used this as a baseline and after some forum/google searches came across this piece of code to get a multi-select output:

Dim ProductArray() As String
    Dim StateArray() As String
    Dim Cnt As Long
    Dim r As Long

'Product Filter
    Cnt = 0
  With Me.ListBox1
        If .ListIndex <> -1 Then
            For r = 0 To .ListCount - 1
                If .Selected(r) Then
                    Cnt = Cnt + 1
                    ReDim Preserve ProductArray(1 To Cnt)
                    ProductArray(Cnt) = .List(r)
                End If
            Next r
        End If
    End With
      
    ActiveSheet.Range("$A$1:$AT$2000").AutoFilter Field:=3, Criteria1:=Array( _
    ProductArray), Operator:=xlFilterValues
    
    'State Filter
    Cnt = 0
    With Me.ListBox2
        If .ListIndex <> -1 Then
            For r = 0 To .ListCount - 1
                If .Selected(r) Then
                    Cnt = Cnt + 1
                    ReDim Preserve StateArray(1 To Cnt)
                    StateArray(Cnt) = .List(r)
                End If
            Next r
        End If
    End With
    
    ActiveSheet.Range("$A$1:$AT$2000").AutoFilter Field:=6, Criteria1:=Array( _
    StateArray), Operator:=xlFilterValues

I thought I had this working at first, but now it seems that I am only getting the last item selected in the listbox. I don't know if this last code section is appropriate to get the output in the correct format. I also tried another method from the forum to output the listbox selection to a column in the worksheet. I was able to do this but then I can't figure out how to take these values and get them in the ("Selection1", "Selection2", "Selection3") format.

Any help/suggestions would be appreciated. If there is a different/better way to acheive the desired outcome, I'm all ears.

Thanks,

Darv

 

[SkipVought]

hi,

I would not COPY/AutoFilter a sheet.

It would be much slicker to ADD a sheet, use Data > Get External Data > From other sources > From Mocrosoft Query ... and drill down to your workbook. Query the sheet containing your data, using the criteria entered on your UserForm, that will add a querytable to the sheet. Naturally you will record a macro that does this. It will take a dozen or so lines of code. The listbox list in question will simply be an IN statement in your SQL like...

    sSQL = "select *"
    sSQL = sSQL & vbLf
    sSQL = sSQL & "from [YourSheetName$]"
    sSQL = sSQL & vbLf
    sSQL = sSQL & "where [YourDateFieldName] between #" & Format(StartDate, "yyyy/mm/dd") & "# and #" & Format(EndDate, "yyyy/mm/dd") & "# "
    sSQL = sSQL & "  and and WhateverFieldName IN ('Selection1', 'Selection2', 'Selection3')"

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[PHV]

You already have an array, so use this:
ActiveSheet.Range("$A$1:$AT$2000").AutoFilter Field:=3, Criteria1:=ProductArray, Operator:=xlFilterValues

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886

 

[darvistor]

Thanks Skip. I will look into your suggestions. Thansk PHV, this seems to resolve the issue. Not sure why I didn't think of that. That's what I get for copying the code from somewhere else.

Darv.

 

[darvistor]

Ok, I just discovered a new issue with my form and data. The product list that I am using for the userform is a unique value list. It simply lists the 15 possible product choices. However, there are some records with more than one product selected such as Product1,Product2 or Product1,Product6. If I include all the possible combinations currently used before the product list would be over a hundred entries.

What I had intended the userform to do was to act like a "contains" filter so that the user wouldnt have to scroll through all the possible selections and manually check all the choices that contain the product they are looking for. So if I select Product1,Product2 and Product4 in my listbox and run the code my filtered list just has those three selections and ignores things like Product1,Product6 or Product2,Product3,Product4.

The filter option only allows 2 choices for the contains option. I'm not sure if this can be coded using an array function as I would need my data in the array to have the "*Product1*, *Product2*" format.

Skip, I created a new workbook and attempted to do the get data from external sources option as you suggested. I recorded the macro, but when I ran the final query to output to excel I received a "Too Many Continuous Lines" error. I do get some data outputed, and I would just need to code the query to replace my selections with variables from the userform. When I look at the code it is all red and I am not sure where the error is in the code. I will work on this option in parallel.

Thanks
Darv

 

[darvistor]

Can someoen take a look at this code that was created using a macro and the query builder? It looks messy with the breaks, but this is how it was recorded. I just edited the text for confidentiality reasons.

Sub Macro1()    
With ActiveSheet.ListObjects.Add(SourceType:=0, Source:=Array(Array( _
        "ODBC;DSN=Excel Files;DBQ=R:\FilePath\Data.xlsm;DefaultDir=R:\FilePath;DriverId=1046;MaxBufferSize=204" _
        ), Array("8;PageTimeout=5;")), Destination:=Range("$A$1")).QueryTable
        .CommandText = Array( _
        "SELECT `'Table1$'`.`Record ID`, `'Table1$'`.`Date Created`, `'Table1$'`.`Product`, `'Table1$'`.Classification, `'Table1$'`.`Sho" _
        , _
        "rt Description`, `'Table1$'`.State, `'Table1$'`.`Closed On`" & Chr(13) & "" & Chr(10) & "FROM `'Table1$'` `'Table1$'`" & Chr(13) & "" & Chr(10) & "WHERE (`'Table1$'`.`Date Created`>={ts '2013" _
        , _
        "-01-01 00:00:00'}) AND (`'Table1$'`.`Date Created`<={ts '2013-12-31 00:00:00'}) AND (`'Table1'`.`Product` Like '%Product1%') AND (`'Table1$'`.State=" _
        , _
        "'Closed - Done') OR (`'Table1$'`.`Product` Like '%Product2%') AND (`'Table1$'`.State='Closed - Done') OR (`'Table1$'`.`Product` Like '%Product" _
        , _
        "1%') AND (`'Table1$'`.State='Closed - Done') OR (`'Table1$'`.State='Record Closed')" _
        )
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .PreserveColumnInfo = True
        .ListObject.DisplayName = "Table_Query_from_Excel_Files"
        .Refresh BackgroundQuery:=False
    End With
End Sub

I created a few queries with a set date range and then just manually changed the product list and states. I ended up with around 10 different queries. While this works it is not ideal since they queries cannot be easily edited using the wizard. The user would have to manually go in and adjust the dates and criteria leaving an opportunity for someone to miss something or not do it the same. I cant seem to get this query to work using the variables for the dates or to replace the various Like statements with selections from my text box.

Any thoughts?

Darv

 

[SkipVought]

Each and Every time that you run YOUR macro, it ADDS a separate querytable to your sheet, unecessarily.

Try this...

Sub Macro1()
    Dim sPath As String, sDB As String, sConn As String, sSQL As String
    
    sPath = "R:\FilePath"
    
    sDB = "Data.xlsm"
    
    sConn = "ODBC;DSN=Excel Files;"
    sConn = sConn & "DBQ=" & sPath & "\" & sDB & ";"
    sConn = sConn & "DefaultDir=" & sPath & ";"
    sConn = sConn & "DriverId=1046;MaxBufferSize=2048;PageTimeout=5;"
    
    sSQL = "SELECT"
    sSQL = sSQL & "  `'Table1$'`.`Record ID`"
    sSQL = sSQL & ", `'Table1$'`.`Date Created`"
    sSQL = sSQL & ", `'Table1$'`.`Product`"
    sSQL = sSQL & ", `'Table1$'`.Classification"
    sSQL = sSQL & ", `'Table1$'`.`Short Description`"
    sSQL = sSQL & ", `'Table1$'`.State"
    sSQL = sSQL & ", `'Table1$'`.`Closed On`"
    sSQL = sSQL & vbLf
    sSQL = sSQL & "FROM `'Table1$'` `'Table1$'`"
    sSQL = sSQL & vbLf
    sSQL = sSQL & "WHERE (`'Table1$'`.`Date Created`>={ts '2013-01-01 00:00:00'})"
    sSQL = sSQL & "  AND (`'Table1$'`.`Date Created`<={ts '2013-12-31 00:00:00'})"
    sSQL = sSQL & "  AND (`'Table1'`.`Product` Like '%Product1%')"
    sSQL = sSQL & "  AND (`'Table1$'`.State='Closed - Done')"
    sSQL = sSQL & "   OR (`'Table1$'`.`Product` Like '%Product2%')"
    sSQL = sSQL & "  AND (`'Table1$'`.State='Closed - Done')"
    sSQL = sSQL & "   OR (`'Table1$'`.`Product` Like '%Product1%')"
    sSQL = sSQL & "  AND (`'Table1$'`.State='Closed - Done')"
    sSQL = sSQL & "   OR (`'Table1$'`.State='Record Closed')"
    
    With ActiveSheet.ListObjects(1).QueryTable
            .Connection = sConn
            .CommandText = sSQL
            .Refresh BackgroundQuery:=False
    End With
End Sub

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[SkipVought]

oops TYPO in this statment missing the [highlight]$[/highlight] character...

Sorry

    sSQL = sSQL & "  AND (`'Table1[highlight]$[/highlight]'`.`Product` Like '%Product1%')"

Skip,
[sub]
Just traded in my OLD subtlety...
for a NUance![/sub]

 

[darvistor]

Where do I run this from Skip? Can I just add this to a command button? Why SQL commands vs what I have originally? Just curious as I have not used these commands in a while. The problem I still have is that when I try to use my StartDate and EndDate commands for the following it doesnt work.

(`'Table1$'`.`Date Created`>={ts '2013-01-01 00:00:00'})"

'replaced with
(`'Table1$'`.`Date Created`>={ts StartDate})"

I have the same issue with the product select (which is stored in my Product Array) in that sometimes I may select two products and sometimes I may select 4 products so the number of "Like" commands may change.

Thanks for your input so far Skip. I have been using the query function quite a bit now to look at other data sources and I never knew it was there.

Darv

 

[PHV]

'replaced with
(`'Table1$'`.`Date Created`>={ts '" & Format(StartDate, "yyyy-mm-dd hh:nn:ss") & "'})"

Hope This Helps, PH.
FAQ219-2884
FAQ181-2886