Generating a data validation list and sorting it alphabetically

Question

The following code clears 11 columns that contain lists that are used for data validation on another worksheet. This list is constantly changing due to records being added/removed from the source data. Basically I'm checking every value in a column, and if it meets all of my criteria I'm adding it to my data validation column (after making sure it doesn't already exist there).

Once I've populated my 11 columns, I sort each one alphabetically. This is the portion of my code that I don't like. While it doesn't explicitly select anything, I can see on my worksheet the last column that was sorted because it is selected.

What I'm wondering is if there's a better way to dynamically generate this list alphabetically without having to use .Sort - possibly populating an array and then sorting it alphabetically? I've never sorted an array in VBA, so I'm not sure 1. If it's even more efficient and 2. What is the best method to sort an array, if that's the approach I should take here?

Code:

Option Explicit
Sub PopulateAllDataValidationLists()

    Dim sht As Worksheet, sht2 As Worksheet
    Dim i As Long, listcol As Long

    Set sht = Worksheets("Sheet 1")
    Set sht2 = Worksheets("Data Validation")

        Application.ScreenUpdating = False

        sht2.Range("A2:K500").ClearContents

        For i = 1 To 11
            listcol = sht.Rows("1:1").Find(What:=sht2.Cells(1, i).Value, LookAt:=xlWhole).Column

            For j = 2 To sht.Cells(sht.Rows.Count, listcol).End(xlUp).Row
                If IsError(Application.Match(sht.Cells(j, listcol).Value, sht2.Range(ColumnLetter(i) & ":" & ColumnLetter(i)), 0)) And _
                sht.Cells(j, listcol).Value <> "" And _
                sht.Cells(j, listcol).Value <> "UNK" And _
                sht.Cells(j, listcol).Value <> "xxx" And _
                sht.Cells(j, listcol).Value <> "yyy" And _
                sht.Cells(j, listcol).Value <> "zzz" And _
                sht.Cells(j, listcol).Value <> "yxz" And _
                sht.Cells(j, listcol).Value <> "zyx" And _
                Len(sht.Cells(j, listcol).Value) <= 3 Then
                    sht2.Cells(sht2.Cells(sht2.Rows.Count, i).End(xlUp).Row + 1, i).Value = sht.Cells(j, listcol).Value
                End If
            Next j

        Next i

        'Sort all alphabetically
        For i = 1 To 11
            Worksheets("Data Validation").Sort.SortFields.Clear
            Worksheets("Data Validation").Sort.SortFields.Add Key:=Range(ColumnLetter(i) & "2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

            With Worksheets("Data Validation").Sort
                .SetRange Range(ColumnLetter(i) & "2:" & ColumnLetter(i) & sht2.Cells(sht2.Rows.Count, i).End(xlUp).Row)
                .Header = xlNo
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        Next i

        Application.ScreenUpdating = True

End Sub
Function ColumnLetter(colnum As Long) As String

    ColumnLetter = Split(Cells(1, colnum).Address, "$")(1)

End Function

An example of data in a column:

Answer 1

I would refactor your code and add Worksheets("Data Validation").Range("A1").Select to the end to clear the selection.

Refactored Code

Changes:

• ColumnLetter(): Removed
• sht2: Replaced using a With block.
• For j: Changed to For item. item.Value is much easier to distinguish than sht.Cells(j, listcol).Value
• .Range("A1").Select: Added to clear the dreaded selected column
• Cell reference fully qualified for the Sort ranges (I am surprised that the code would run without Worksheets("Data Validation") being the ActiveSheet.
• sht2.Range("A2:K500").ClearContents: Replaced made dynamic using sht2.Range("A1:K1").CurrentRegion.Offset(1).ClearContents

---

Sub PopulateAllDataValidationLists()
    Dim sht As Worksheet
    Dim i As Long, listcol As Long
    With Worksheets("Data Validation")
        Application.ScreenUpdating = False

        .Range("A1:K1").CurrentRegion.Offset(1).ClearContents
        Dim columnName As String
        Dim InvalidValues As Variant

        InvalidValues = Array("UNK", "xxx", "yyy", "zzz", "yxz", "zyx")

        Dim rColumn As Range, item As Range
        For i = 1 To 11
            columnName = .Cells(1, i).Value
            With Worksheets("Sheet 1")
                listcol = .Rows("1:1").Find(What:=columnName, LookAt:=xlWhole).Column
                Set rColumn = Range(.Cells(1, listcol), .Cells(.Rows.Count, listcol).End(xlUp))
            End With

            For Each item In rColumn
                If item.Value <> "" Then
                    If IsError(Application.Match(item.Value, .Columns(i), 0)) And _
                       IsError(Application.Match(item.Value, InvalidValues, 0)) And _
                       Len(item.Value) <= 3 Then
                        .Cells(.Cells(.Rows.Count, i).End(xlUp).Row + 1, i).Value = item
                    End If
                End If
            Next

            .Sort.SortFields.Clear
            .Sort.SortFields.Add Key:=.Cells(2, i), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            Dim target As Range
            Set target = Range(.Cells(2, i), .Cells(.Rows.Count, i).End(xlUp))

            With .Sort
                .SetRange target
                .Header = xlNo
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        Next i
        .Range("A1").Select
    End With

    Application.ScreenUpdating = True

End Sub

Other Method

There are many ways that you can sort the data:

• System.Collection.ArrayList : ArrayList Class (System.Collections) | Microsoft Docs, VBA for smarties: ArrayList
• System.Collections.SortedList: SortedList Class (System.Collections) | Microsoft Docs, VBA voor smarties: SortedList, VBScript Scripting Techniques: SortedLists - Rob van der Woude
• Bubble Sort: VBA Arrays - Bubble Sort - BetterSolutions.com
• Quick Sort: VBA Arrays - Quick Sort - BetterSolutions.com

Here is an example of how you can use an ADODB.Recordset to create a table in memory to sort and potentially filter the data.

RSSort: Class

Option Explicit
Public FieldName As String
Private Const adVarChar = 200
Private Const adOpenKeyset = 1
Private Const adUseClient = 3
Private Const adLockPessimistic = 2
Private rs As Object

Private Sub Class_Initialize()
    FieldName = "Values"
    Set rs = CreateObject("ADODB.Recordset")

    With rs
        .Fields.Append FieldName, adVarChar, 255
        .CursorType = adOpenKeyset
        .CursorLocation = adUseClient
        .LockType = adLockPessimistic
        .Open
    End With
End Sub

Public Sub AddNew(ByVal item As Variant)
    rs.AddNew FieldName, item
End Sub

Public Property Get Filter() As String
    Filter = rs.Filter
End Property

Public Property Let Filter(ByVal sFilter As String)
    rs.Filter = sFilter
End Property

Public Sub Sort(Optional SortAscending As Boolean = True)
    rs.Sort = FieldName & IIf(SortAscending, " ASC", " DESC")
End Sub

Public Function ToArray() As Variant
    Dim data As Variant, results As Variant
    If rs.RecordCount = 0 Then
        ReDim results(1 To 1, 1 To 1)
        ToArray = results
        Exit Function
    End If
    rs.MoveFirst
    data = rs.GetRows(rs.RecordCount)
    ReDim results(1 To UBound(data, 2) + 1, 1 To 1)

    Dim r As Long

    For r = 1 To UBound(data, 2)
        results(r + 1, 1) = data(0, r)
    Next

    ToArray = results
End Function

Demo Code

Sub RSSorterPopulateAllDataValidationLists()
    Application.ScreenUpdating = False

    Dim data As Variant
    Dim c As Long

    With Worksheets("Data Validation")
        .Range("A1:K1").CurrentRegion.Offset(1).ClearContents
        For c = 1 To 11
            data = getValidationValues(.Columns(c), "", "UNK", "xxx", "yyy", "zzz", "yxz", "zyx")
            .Cells(2, c).Resize(UBound(data)).Value = data
        Next
    End With
End Sub

Function getValidationValues(MatchColumn As Range, ParamArray InvalidValues() As Variant) As Variant()
    Dim sorter As New RSSorter
    Dim col As Range
    Dim ColumnHeader As String
    ColumnHeader = MatchColumn.Cells(1, 1).Value
    Dim vExcluded As Variant
    vExcluded = InvalidValues

    With Worksheets("Sheet 1")
        Dim item As Range
        Set col = .Rows("1:1").Find(What:=ColumnHeader, LookAt:=xlWhole)
        If Not col Is Nothing Then
            For Each item In Range(col.Cells(2, 1), .Cells(.Rows.Count, col.Column).End(xlUp))
                If item.Value <> "" Then
                    If IsError(Application.Match(item.Value, MatchColumn, 0)) And _
                       IsError(Application.Match(item.Value, vExcluded, 0)) And _
                       Len(item.Value) <= 3 Then
                        sorter.AddNew item
                    End If
                End If
            Next
        End If
    End With
    sorter.Sort
    getValidationValues = sorter.ToArray
End Function

Edit

• shtreplaced with With Worksheets("Sheet 1")
• Constants (adOpenKeyset, adUseClient, adLockPessimistic) added to completely convert from early binding to late binding.
• The ADODB library "Microsoft ActiveX Data Objects x.x Library" removed from original workbook