How do I sort a dictionary collection?

Okay so this is driving me nuts as I have searched and searched and found no way possible except a Cpearson example which requires I download an additional add on which is not feasible as I am not having my users install new add ons to use a template.

I have a dictionary of strings, this is the easiest way for me to get a unique list of teams from a column filled with thounsands of rows. And I did not want to create an array of possibly a couple hundred in size.

Now my only problem is I need this dictionary sorted, or to at least print in alphabetical order.

500 point to anyone who can do this, obviously putting the dictionary into an array and then sorting the array is not optimal as I said this could have hundreds of outputs....

Thanks


'*** Gets unique and sorted list of teams
     Dim dic As Object, x, r As Range
        Set dic = CreateObject("Scripting.Dictionary")
            For Each r In Sheets(SheetName).Range("H3", Sheets(SheetName).Range("H65536").End(xlUp))
                If Not IsEmpty(r) Then
                    If Not dic.exists(r.Value) Then
                        dic.Add r.Value, Nothing
                    End If
                End If
            Next
            
    ' How many teams?
    'dic.Count
    
'Iterate through the array of items. These items can include objects aswell.
    i = 4
    For Each strKey In dic.keys()
        SheetXXX.Range("E" + CStr(i)).Value = strKey
        i = i + 1
    Next

Open in new window

AfterlifeAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

RichardSchollarCommented:
I would change the way you are doing it and actually use Advanced Filter to return the unique list (eg to a temporary or hidden sheet) and then sort the list on the sheet using Excel's built in commands, then return that list to an array for onward processing.

Dictionaries aren't really built for sorting (as they're dictionaries) so using your current process I *think* you would need to employ an array and then sort that using a Bubblesort or Quicksort method.

Richard
0
AfterlifeAuthor Commented:
Care to help with the code?

Data is in H3-> end need this entire column unique sorted into an array.
0
RichardSchollarCommented:
Sure - something like this:

[code]Sub tEST()
Dim rng As Range
Dim ws As Worksheet
Dim varArray As Variant
Dim xlCalc As XlCalculation

With Application
    xlCalc = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With

Set ws = Worksheets.Add   'temporary sheet

'next bit filters for uniques:
With Worksheets("Sheet4") 'amend as appropriate
    .Range("H3").EntireRow.Insert
    .Range("H3").Value = "Temp Header"
    Set rng = .Range("H3").Resize(.Cells(.Rows.Count, "H").End(xlUp).Row - .Range("H3").Row + 1)
End With
rng.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=ws.Range("A1"), Unique:=True

'next bit sorts:
ws.Range("A1").CurrentRegion.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
       
'next bit places sorted list into variant array for further processing:
With ws.Range("A1").CurrentRegion
    varArray = .Resize(.Rows.Count - 1).Offset(1).Value
End With


'other code....

'clean up:

Application.DisplayAlerts = False
ws.Delete
Sheets("Sheet4").Rows(3).Delete
Application.Calculation = xlCalc
End Sub[/code]

You end up with a variant array (2 dimensional - how ever many rows but only the single column) holding the uniques in sorted order (ascending).

Richard
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
The Ultimate Tool Kit for Technolgy Solution Provi

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy for valuable how-to assets including sample agreements, checklists, flowcharts, and more!

patrickabCommented:
Afterlife,

>I have a dictionary of strings, this is the easiest way for me to get a unique list of teams from a column filled with thounsands of rows. And I did not want to create an array of possibly a couple hundred in size.

It is by far the easiest to create a New Collection of unique items (strings), then assign them to an array, sort the array using say a Bubble sort (as it's the simplest for me to understand) and then output the result from the sorted array. For a Collection that is not too large it works well and adequately fast. Although I have not tested it I understand that the bubble sort becomes slow for large arrays.

Attached is a file with a simple bubble sort routine. The VBA doesn't include the creation and assignment of a New Collection to an array ready for sorting but I guess you will know that already - if not, do please ask.

By the way I have often used this technique to create unique sorted lists that I can use in VBA routines - so it does work.

Patrick
bubble-sort.xls
0
AfterlifeAuthor Commented:
Thanks guys, defiantly helped. Both solutions will work, and will depend on the circumstance.

@patrickab if you do get a chance to add the code for creation etc that would help. My coding is more trial and error and google. But with repetition of certain macros I am learning!
0
patrickabCommented:
Afterlife,

Hope it the help wasn't too defiant !

Meantime thanks for the points.

Patrick

ps I'll find a file where you can see it all working together.
0
patrickabCommented:
Afterlife,

Look at the code pane 'behind' the Userform...

In the Private Sub UserForm_Initialize() in the attached file you will see:

- the creation of a New Collection containing only unique items
- the assignment of each element of the Collection to an array
- the Bubble sorting of that array
- the outputting of that sorted array to a ListBox on a UserForm

Hope that helps

Patrick


Private Sub UserForm_Initialize()
'initialise Userform1 and populate ListBox1 with all the Makes of the cars
Dim coll As New Collection
Dim rng As Range
Dim celle As Range
Dim str1 As String
Dim str2 As String
Dim rowe As Long
Dim i As Long
Dim n As Long
Dim temp As String
Dim coll_arr() As String

rowe = 2
str1 = "D"
str2 = "D"
With Sheets("Filter")
    Set rng = Range(.Cells(rowe, str1), .Cells(.Cells.Rows.Count, str2).End(xlUp))
End With

'cycle through data and add to the Collection if it's not already in the Collection
'the Collection will only accept unique items the way it's written here
For Each celle In rng
    If celle <> "" And UCase(celle) <> "OTHER" Then
        On Error Resume Next
        coll.Add celle, celle
    End If
Next celle

're-dimension the array ready to accpet all the elements of the Collection
ReDim coll_arr(coll.Count)

'assign all the lelements of the Collection to the array
For i = 1 To coll.Count
    coll_arr(i) = coll(i)
Next i

temp = ""
'Sort the array using a bubble sort
For n = 1 To coll.Count
    For i = 1 To coll.Count
        If coll_arr(n) < coll_arr(i) Then
            temp = coll_arr(n)
            coll_arr(n) = coll_arr(i)
            coll_arr(i) = temp
            If i = coll.Count Then
                coll_arr(coll.Count) = temp
            End If
            temp = ""
        End If
    Next i
Next n

UserForm1.ListBox2.Clear
UserForm1.ListBox3.Clear
UserForm1.ListBox4.Clear
UserForm1.TextBox1.Text = ""
UserForm1.TextBox2.Text = ""
'output the sorted array to ListBox1 on Userform1
For i = 1 To coll.Count
    UserForm1.ListBox1.AddItem coll_arr(i)
Next i

End Sub

Open in new window

car-data-06.xls
0
AfterlifeAuthor Commented:
Thanks!!
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Programming

From novice to tech pro — start learning today.