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

x
?
Solved

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

Posted on 2010-09-08
7
Medium Priority
?
1,067 Views
Last Modified: 2013-11-10
Hi,

I have 5 fields for which I need to loop through via Autofilter and apply a function I wrote.

I attempted this using the scripting.dictionary. The problem I came across with is, even though the 5 scripting dictionary (for the 5 fields) were unique, certain combinations returned no rows and 5 colums by 10928 rows...i stopped the code after 3 minutes. Not usuable in this business setting.

I tried creating logic to go around this by at the 3rd field, it's already proving to be a daunting task and I'm here to ask if there's an easy way around this?

Thanks everyone.
0
Comment
Question by:Shino_skay
  • 3
  • 2
  • 2
7 Comments
 
LVL 39

Assisted Solution

by:nutsch
nutsch earned 1000 total points
ID: 33629579
you want to pull out all combinations of these 5 fields?

What do you want to do with them next?

Have you tried doing a scripting dictionary for the 5 fields together, directly from the data, as in
field1value|field2value|field3value|field4value|field5value

This would only give you existing line items and might speed up your process.

Thomas

PS Maybe a file upload and a clearer description of what you're trying to achieve would help.
0
 

Author Comment

by:Shino_skay
ID: 33630707
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.
0
 

Author Comment

by:Shino_skay
ID: 33631138
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!
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
LVL 39

Assisted Solution

by:nutsch
nutsch earned 1000 total points
ID: 33631478
You can either make a new column (not as pretty but faster and easier), or you use the dictionnary to remove duplicates, then for each value in the dictionnary, you split the value and update the filter for each field (prettier but more complex).

Thomas
0
 
LVL 93

Accepted Solution

by:
Patrick Matthews earned 1000 total points
ID: 33632259
This seems to be working, borrowing Thomas's suggestion of using a concatenated key.

The different combinations are output to new worksheets.

For more info on using the Dictionary in VBA, you may want to look at my article: http://www.experts-exchange.com/Software/Office_Productivity/Office_Suites/MS_Office/A_3391-Using-the-Dictionary-Class-in-VBA.html

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
    
    Const Delimiter As String = "$iodj!w"
    
    Application.ScreenUpdating = False
    
    Set dic = CreateObject("Scripting.Dictionary")
    dic.CompareMode = vbTextCompare
    
    Set Source = ThisWorkbook.Worksheets("Random Sample Data")
    With Source
        LastR = .Cells(.Rows.Count, "a").End(xlUp).Row
        LastC = .Cells(1, .Columns.Count).End(xlToLeft).Column
        Set rng = .Range(.[a1], .Cells(LastR, LastC))
        arr = rng.Value
        For Counter = 2 To UBound(arr, 1)
            TestKey = Join(Array(arr(Counter, 3), arr(Counter, 4), arr(Counter, 5), arr(Counter, 6), _
                arr(Counter, 7)), Delimiter)
            dic.Item(TestKey) = TestKey
        Next
        .[a1].AutoFilter
        Keys = dic.Keys
        For Counter = 0 To UBound(Keys)
            arr = Split(Keys(Counter), Delimiter)
            .[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)
            With ThisWorkbook
                Set Dest = .Worksheets.Add(After:=.Worksheets(.Worksheets.Count))
            End With
            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
            rng.SpecialCells(xlCellTypeVisible).Copy Dest.[a1]
        Next
        .[a1].AutoFilter
        .Select
    End With
    
    Set dic = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "Done"
    
End Sub

Open in new window

Q-26459483.xls
0
 

Author Comment

by:Shino_skay
ID: 33636574
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.
0
 
LVL 93

Expert Comment

by:Patrick Matthews
ID: 33638733
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

Open in new window

0

Featured Post

Free Tool: Site Down Detector

Helpful to verify reports of your own downtime, or to double check a downed website you are trying to access.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article describes how you can use Custom Document Properties to store settings and other information in your workbook so that they will be available the next time you open the workbook.
What do responsible coders do? They don't take detrimental shortcuts. They do take reasonable security precautions, create important automation, implement sufficient logging, fix things they break, and care about users.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…
Progress

872 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question