June 08, 2010

A Dynamic Sorted List

I like Dynamic Ranges. You can use them to get a list of values that expands or contracts, such as a list of clients that is constantly getting updated.

One problem however can be that your list might not be sorted. If the list is long, you might have a problem trying the find a certain value. Also, the list might contain duplicates. Better to get rid of them if possible.

You could go about getting a sorted list of unique values by adding some code to make yet another dynamic range from the original dynamic range. But it occurred to me, why use dynamic ranges at all? How about just doing everything in code?

Here is a picture of some names in Column A (unsorted and with duplicates). And there is a dropdown (validation) list in Cell B1.

And here is the code used to get the unique values, sort the list and add the dropdown. Open the Visual Basic Editor, locate your workbook and paste the code into the appropiate sheet module. Anytime you add or delete names in Colummn A, it will update the list accordingly.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim UniqueList As New Collection
    Dim itm As Variant
    Dim c As Range
    Dim rList As Range
    Dim lCount As Long
    Dim sList As String
    Dim varList() As Variant
    Dim varTemp As Variant
    Dim i As Long, j As Long
    If Target.Column <> 1 Then Exit Sub
    If Target.Cells.Count > 1 Then Exit Sub
    On Error Resume Next
    'Turn off events (remember ALWAYS set back on when finished!)
    Application.EnableEvents = False
    sList = ""
    'Set rList as range from Cell A1 downwards
    Set rList = Range(Cells(1, 1), Cells(1, 1).End(xlDown))
    'Add all values in the range to a collection
    'Only unique values will be added (errors ignored via On Error Resume Next)
    For Each c In rList
        UniqueList.Add c.Value, CStr(c.Value)
    Next c
    'All all items in collection to array
    For Each itm In UniqueList
        lCount = lCount + 1
        ReDim Preserve varList(1 To lCount)
        varList(lCount) = itm
    Next itm
    'Now sort the array
    For i = LBound(varList) To UBound(varList) - 1
        For j = i + 1 To UBound(varList)
            If varList(i) > varList(j) Then
                varTemp = varList(j)
                varList(j) = varList(i)
                varList(i) = varTemp
            End If
        Next j
    Next i
    'Loop though array and make a string that conntains the list
    For i = UBound(varList) To LBound(varList) Step -1
        If sList = "" Then
            sList = varList(i)
            sList = varList(i) & "," & sList
        End If
    Next i
    'Add a dropdown list of names to Cell B1
    With Cells(1, 2).Validation
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
             xlBetween, Formula1:=sList
    End With
    'Turn events back on
    Application.EnableEvents = True
    On Error GoTo 0
End Sub

A little long? Maybe, but the code is very re-usable :-)  

Posted by andrewe at 19:11