Excel VBA Dynamic data validation drop downs with multiple criteria ranking

Question

I am trying to create a dynamic drop down data validation list that will rank multiple criteria (#2 or more) from a worksheet, there are 300 items in my list and I want to rank them based on information in another worksheet in a table.

Based on the rank (1 to 300) I would like the drop down data validation list to contain top 10, top 25 and top/bottom # values calculated from their rank. I don't mind helper columns. If the data/table I am ranking from changes, and/or if I want to add a criteria I would like the top 10, top 25 etc to change accordingly.

I have recorded with the macro recorder when I use the advanced filter and also the top 25 in this case values.

Sub Makro2()
Selection.AutoFilter
Range("T[#All]").AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
    Range("A1:J3"), Unique:=False

Range("T[[#Headers],[2017]]").Select
ActiveSheet.ShowAllData

Selection.AutoFilter

ActiveSheet.ListObjects("T").Range.AutoFilter Field:=2, Criteria1:="25", _
    Operator:=xlTop10Items
End Sub

Is this possible in Excel 2016 with or without VBA?

Edit: I found this thread Data Validation drop down list not auto-updating and this code in that thread could be what I am looking for.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
' Ensure all lists are made from tables and that these tables are named
' in the Name Manager.
' When creating your Data Validation List, instead of selecting a range
' in 'Source', click within 'Source' and press 'F3'. Finally select your
' tables name.
Dim strValidationList As String
Dim strVal As String
Dim lngNum As Long

On Error GoTo Nevermind
strValidationList = Mid(Target.Validation.Formula1, 2)
strVal = Target.Value
lngNum = Application.WorksheetFunction.Match(strVal, ThisWorkbook.Names(strValidationList).RefersToRange, 0)

' Converts table contents into a formula
If strVal <> "" And lngNum > 0 Then
    Application.EnableEvents = False
    Target.Formula = "=INDEX(" & strValidationList & ", " & lngNum & ")"
End If

Nevermind:
    Application.EnableEvents = True

End Sub

Update:

I am using the LARGE function to get the top 15 values of Table1. I am then using INDEX and MATCH to find the names of the top 15 values (column 2).

I am then using the OFFSET function and a NAMED RANGE to get a data validation list that auto updates when I add something to the bottom of the list.

Now I want the data validation list to be dependent on the first drop down. How can I achieve this?

Answer 1

EDIT: you want to change code to xlDescending, but same idea applies

Prior to worksheet_change event firing, we see that range is unsorted. The first ten items showing as options in the cell D1 are the first ten items in the range.

When we make a change to a value in range I1:I20 we trigger the worksheet_change event. Inside this function we have code that will sort the range H1:I20.

Here is the code for the worksheet_change function, and where it is to be placed that is inside the worksheet module of the worksheet that you are working with

Finally here is how to link your data validation restrictions with the range. Changes to the range H1:I10 (aka the top ten) will change the options available to you in the box.

The snippet of code

Private Sub Worksheet_Change(ByVal Target As Range)
        Dim rangeOfTable As Range
            Set rangeOfTable = ActiveSheet.Range("H1:I20")

        If Not Application.Intersect(Target, rangeOfTable) Is Nothing Then
            rangeOfTable.Sort Range("I1:I20"), xlAscending
        End If
End Sub

EDIT: Works with dropDown boxes too

EDIT: this code will give you idea RE how to sort multiple values

Private Sub Worksheet_Change(ByVal Target As Range)
        Dim rangeOfTable As Range
            Set rangeOfTable = ActiveSheet.Range("H1:J20")

        If Not Application.Intersect(Target, rangeOfTable) Is Nothing Then
            With rangeOfTable
                .Sort key1:=ActiveSheet.Range("I1:I20"), order1:=xlAscending, _
                    key2:=ActiveSheet.Range("J1:J20"), Order2:=xlAscending
            End With
        End If
End Sub

here is the data after the event has triggered, notice that the top ten in the list are the only ten available in the drop down box

Answer 2

You are approaching it correctly, sorting or filtering your list data prior to loading the list. I am confused about your question but it appears you are wondering how to create the data validation drop down after you have manipulated your list?

Here is an example of how this is done with a simple test code written to build a state list and then a county list based on the state chosen. Maybe this helps you build your validation lists.

There are two worksheets:

1) one for Data List items ThisWorkbook.Worksheets("DataList")

2) one for the drop downs ThisWorkbook.Worksheets("DD Report Testing")

In a module Create_State_List

Option Explicit

'This is a two part validation, select a state and then select a county

Sub CreateStateList()
   Dim FirstDataRow As Double, LastDataRow As Double
   Dim StateCol As Double, CountyCol As Double
   Dim DataListSht As Worksheet
   Dim DDReportSht As Worksheet

   Dim StateListLoc As String
   Dim StateRange As Range

   Set DataListSht = ThisWorkbook.Worksheets("DataList")
   Set DDReportSht = ThisWorkbook.Worksheets("DD Report Testing")
   FirstDataRow = 3 'First row with a State
   StateCol = 2 'States are in Col 2 ("B")
   LastDataRow = DataListSht.Cells(DataListSht.Rows.Count, StateCol).End(xlUp).Row

   Set StateRange = DataListSht.Range(DataListSht.Cells(FirstDataRow, StateCol), DataListSht.Cells(LastDataRow, StateCol))

   StateListLoc = "D3" 'This is where the drop down is located / will be updated

   DDReportSht.Range(StateListLoc).ClearContents 'Clear the list as we build dynamically
   DDReportSht.Range(StateListLoc).Validation.Delete 'Clear the Validation

   'Create the State List
   With Range(StateListLoc).Validation
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=DataList!" & StateRange.Address
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With

End Sub

In a module Create_County_List

Option Explicit

Private Sub CreateCountyList(StateChosen As String)

    Dim DataListSht As Worksheet
    Dim DDReportSht As Worksheet
    Dim StateRow As Double
    Dim NumStateCols As Double
    Dim StartStateCol As Double
    Dim i As Integer
    Dim LastDataRow As Double
    Dim CountyRange As Range
    Dim CountyListLoc As String

    Set DataListSht = ThisWorkbook.Worksheets("DataList")
    Set DDReportSht = ThisWorkbook.Worksheets("DD Report Testing")
    NumStateCols = 51 'We count the District of Columbia
    StateRow = DataListSht.Range("C2").Row
    StartStateCol = DataListSht.Range("C2").Column

    For i = 0 To NumStateCols 'Account for starting at zero rather than 1

        If CStr(Trim(DataListSht.Cells(StateRow, StartStateCol + i))) = StateChosen Then
            'find the last Data row in the column where the match is
            LastDataRow = DataListSht.Cells(DataListSht.Rows.Count, StartStateCol + i).End(xlUp).Row

            'Make the Dynamic list of Counties based on the state chosen
            Set CountyRange = DataListSht.Range(DataListSht.Cells(StateRow + 1, StartStateCol + i), DataListSht.Cells(LastDataRow, StartStateCol + i))

            CountyListLoc = "D4"

            DDReportSht.Range(CountyListLoc).ClearContents
            DDReportSht.Range(CountyListLoc).Validation.Delete

            'Create the County List
            With Range(CountyListLoc).Validation
                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                xlBetween, Formula1:="=DataList!" & CountyRange.Address
                .IgnoreBlank = True
                .InCellDropdown = True
                .InputTitle = ""
                .ErrorTitle = ""
                .InputMessage = ""
                .ErrorMessage = ""
                .ShowInput = True
                .ShowError = True
            End With

           'Break loop
           i = 1000 ' should break loop off right here
        Else 'do not build a list
        End If
    Next i

End Sub

The Worksheet contains the Cell selection code

Option Explicit

'This routine will react to changes to a cell in the worksheet
Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim DDReportSht As Worksheet
    Dim StateString As String
    Set DDReportSht = ThisWorkbook.Worksheets("DD Report Testing")

    Call CheckStatusBar 'Lets update the Status bar on selection changes

    'If the cell change is D3 on DD report (they want state so build list for state)
    If Not Intersect(Target, DDReportSht.Range("D3")) Is Nothing Then
            'Clear the county list until the state is chosen to avoid mismatch
            DDReportSht.Range("D4").ClearContents
            DDReportSht.Range("D4").Validation.Delete

            '*** Create the State Drop Down
            Call CreateStateList

    Else 'Do nothing
    End If


    'If the cell change is D4 on DD report (they want the county list so build it based on the state in D3)
    If Not Intersect(Target, DDReportSht.Range("D4")) Is Nothing Then
        'If there was a change to the state list go get the county list set up
        StateString = DDReportSht.Range("D3")
        Application.Run "Create_County_List.CreateCountyList", StateString
    Else 'Do nothing
    End If

    'If cell is D7 build a rig list
    If Not Intersect(Target, DDReportSht.Range("D7")) Is Nothing Then
        'Build the Rig List
        Call CreateRigList
    Else 'Do nothing
    End If

End Sub

DataSet:

Test Validation Worksheet in practice, again it is just a demo: