VBA TIPS
Make the Data Validation function more efficient(sort a list by frequency and extend it without clicking an arrow)

When you input a lot of data in your Excel workbook using the "data validation" function, consider making it work more efficiently by adding the following features to your dropdown choices.

  • Automatically sort the list by the most popular choices
  • Get rid of the need for scrolling in the dropdown
It can be done using VBA.

Example

Assume you have a column A that requires the entry of an application name which is vaildated using Data Validation. The source range for this validation list is C2 to C7.



Normally the validation list is displayed as follows. In the same order of the range (C2 to C7) that validates it. You can see the list when you click the arrow mark in the cell.



The following code keeps a tally of how many times each word is used in the validated cells, then sorts the source range according to those results.

Last, it extends the validation list by automatically "activating" the dropdown arrow for you, as Shown in the picture below.

In this example, the word Word is chosen six times making it the most used list item. Therefore it becomes automatically moved to the top of the list.



Place the following in a worksheet module.

Option Explicit


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Works only when column A is selected
'the argument 1 stands for Column A.
'if you'd like to set AutoValidation to Column B, use 2 instead of 1.
    Call AutoValidation(lngCol:=1)
End Sub


Sub AutoValidation(ByVal lngCol As Long)

    Dim sFormula As String
    If Selection.Count > 1 Then Exit Sub
    If Selection.Column <> lngCol Then Exit Sub
    If sSourceFormula(Selection) = vbNullString Then Exit Sub

    sFormula = sSourceFormula(Selection)
    'Sort
    Call SortValidateList(lngCol, Range(Mid(sFormula, 2)))

    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                        xlBetween, Formula1:=sFormula
        .IgnoreBlank = True
        .InCellDropdown = True
    End With
    SendKeys "%{down}"
End Sub


Private Function sSourceFormula(Target As Range) As String
'if a validation has NOT been set in the Target cell, an error occurs
'so trap that error with this
    On Error Resume Next
    If Target.Validation.Type = xlValidateList Then
        sSourceFormula = Target.Validation.Formula1
    Else
        sSourceFormula = vbNullString
    End If
End Function


Private Sub SortValidateList(ByVal lngCol As LongByVal rSource As Range)
    Dim bFlag As Boolean
    Dim buf As Variant
    Dim i As Long
    Dim sSeq As String

    buf = rSource.Value
    With Application.WorksheetFunction
        Do
            bFlag = True
            For i = 1 To UBound(buf) - 1
                If .CountIf(Columns(lngCol), buf(i, 1)) < _
                   .CountIf(Columns(lngCol), buf(i + 1, 1)) Then
                    sSeq = buf(i, 1)
                    buf(i, 1) = buf(i + 1, 1)
                    buf(i + 1, 1) = sSeq
                    bFlag = False
                End If
            Next
        Loop Until bFlag
    End With
    rSource.Value = buf
End Sub



| HOME |
Copyright © cellmasters.net - colo's junk room All Right Reserved
ABOUT
WORKS
THE CELL MASTERS
CONTACT
LINKS
Tips and Information about Microsoft Excel|Masaru Kaji aka Colo