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],]").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
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?
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
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