VBA: Excel Autofilter - Looping through dropdown values for 5 fields

hi nutsch,

can you clarify what you mean by the 5 fields together? If I was to concatenate all the possible field combination as a unique string , how would I control the autofilter?

the info I have is proprietary. scrubbing it out and filling in dummy info to illustrate the problem is kind of a pain and a last resort.

Thanks.

hey nutcsh,

I think i got what u meant. I have a key in the scripting dictionary that holds the unqiue key for all 5 fields and I have to make a new column and use the unique keys to control the autofilter. Thanks, i wish I was quick to think of that first. Appriecate it!

Thanks Nutsch on that tip, I have to learn how to split the keys in the dictionary but thanks for the insight.

Pat, I have to go through what you submitted line by line, it's as bit over my head at the part where you set the range and the whole join(array) portion but I do see what Nutsch mentioned earlier with your Split(Keys(Counter), Delimiter line.

Sadly, I won't have the time to play with the above code today. I used the "not pretty" method and copy the unique concatenated 5 field string and did my calculations. Have to submit something working soon however, I do appreciate the help you two  gave and I hope I can learn the complex way "to split" sooner than later or learn how to use MS Access.

Shino_skay,

Glad to help!  BTW, if you haven't already done it, I would love it if you could go back to the article and click 'yes' on the 'was this helpful' voting.

Here is the procedure with some comments that may help.

Patrick

Sub SplitThemUp()
    
    Dim dic As Object
    Dim arr As Variant
    Dim Keys As Variant
    Dim Source As Worksheet
    Dim Dest As Worksheet
    Dim rng As Range
    Dim LastR As Long, LastC As Long
    Dim Counter As Long
    Dim TestKey As String
    Dim WsName As String
    
    ' define custom delimiter unlikely ever to be included as part of "real" data

    Const Delimiter As String = "$iodj!w"
    
    Application.ScreenUpdating = False
    
    Set dic = CreateObject("Scripting.Dictionary")

    ' make dictionary NOT case-sensitive in comparing keys

    dic.CompareMode = vbTextCompare
    
    Set Source = ThisWorkbook.Worksheets("Random Sample Data")
    With Source
        ' find row number for last populated cell in Col A
        LastR = .Cells(.Rows.Count, "a").End(xlUp).Row
        ' find column number for last populated cell in Row 1
        LastC = .Cells(1, .Columns.Count).End(xlToLeft).Column
        ' set a range covering all of the data.  I find this method more reliable
        ' than grabbing the UsedRange
        Set rng = .Range(.[a1], .Cells(LastR, LastC))
        ' transfer data to array for fast processing
        arr = rng.Value
        ' loop through array
        For Counter = 2 To UBound(arr, 1)
            ' build concatenated key
            TestKey = Join(Array(arr(Counter, 3), arr(Counter, 4), arr(Counter, 5), arr(Counter, 6), _
                arr(Counter, 7)), Delimiter)
            ' this adds the key to the dictionary if it doesn't already exist, or updates
            ' the item for that key if it already does.  see the article for how this works
            dic.Item(TestKey) = TestKey
        Next
        ' reset autofilter
        .[a1].AutoFilter
        ' dump dictionary keys into array
        Keys = dic.Keys
        ' loop through array
        For Counter = 0 To UBound(Keys)
            ' split the concatenated key into its constituents
            arr = Split(Keys(Counter), Delimiter)
            ' apply autofilter settings
            .[a1].AutoFilter 3, arr(0)
            .[a1].AutoFilter 4, arr(1)
            .[a1].AutoFilter 5, arr(2)
            .[a1].AutoFilter 6, arr(3)
            .[a1].AutoFilter 7, arr(4)
            ' add new worksheet
            With ThisWorkbook
                Set Dest = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
            End With
            ' this block renames the worksheet, with an exception handler if the worksheet
            ' name we try to use is invalid
            On Error Resume Next
            WsName = Left(Replace(Keys(Counter), Delimiter, " "), 31)
            Do
                Dest.Name = WsName
                If Err <> 0 Then
                    Err.Clear
                    WsName = InputBox("Bad WS name.  Enter replacement", "Invalid Entry", WsName)
                Else
                    Exit Do
                End If
            Loop
            On Error GoTo 0
            ' copy the visible cells in our range on the source sheet to the new sheet
            rng.SpecialCells(xlCellTypeVisible).Copy Dest.[a1]
        Next
        ' reset autofilter
        .[a1].AutoFilter
        .Select
    End With
    
    Set dic = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "Done"
    
End Sub

Select allOpen in new window