VBA Help - Dynamic Named Ranges for Drop Down List - Excel 2016

[Johnny Thunder]

Hello All,

I am working on a new project and I have hit a road block. I have searched the interwebs for a solution to my problem but was unable to find a solution I could cater to my issue.

My Problem

• I have a List Column A ("A1:A64") of Unit numbers and in Column B a corresponding list of Unit Descriptions in my "Lookups" sheet.
  • On my "Master" Sheet, I have two Drop Downs Column C and Column D, I would like to be able to have the dropdown in Column D linked to the Unit Numbers Data as a regular Drop Down, the real magic needs to happen in the adjacent dropdown in Column D for the Unit Description.
  • I would need the dropdown in Column D to dynamically show only the available options of Unit Descriptions from the Dropdown in Column C.
• I have seen the use of Named ranges and Offsets to accomplish this but for a small data set, my data can grow monthly so I am looking for a way to do this in a more automated way.
• There will be Unit Numbers that are repeated that will have multiple Unit Description, hence the need for a more dynamic dropdown.
• Please see the sample data below.

My possible solutions (although I don't know how to implement)
1. Using VBA, have a loop that runs down column A and looks for unique Values, if a unique value is found create a Named Range using the Unit# for the Named Range Name.
1a. With the newly created named range, dynamically find the corresponding range of Unit Description in Column B

2. On my "Master" Sheet my Column C Dropdown will only have Unique Unit# as the dropdown options
2b. Then on the corresponding Column D Dropdown I can use the "=Indirect(Col C Value)" in the List Value to bring in the range of options

[TABLE="class: grid, width: 400, align: left"]
<tbody>[TR]
[TD]Column A[/TD]
[TD]Column B[/TD]
[/TR]
[TR]
[TD]Unit#[/TD]
[TD]Unit Descriptions[/TD]
[/TR]
[TR]
[TD]201[/TD]
[TD]OTHER ELIMS.-Default[/TD]
[/TR]
[TR]
[TD]201[/TD]
[TD]OTHER ELIMS.- Games Lic[/TD]
[/TR]
[TR]
[TD]203[/TD]
[TD]DOMESTIC DIGITAL DISTRIBUTION[/TD]
[/TR]
[TR]
[TD]204[/TD]
[TD]INTERNATIONAL DIGITAL DIST.[/TD]
[/TR]
[TR]
[TD]205[/TD]
[TD]DOMESTIC HOME VIDEO[/TD]
[/TR]
[TR]
[TD]206[/TD]
[TD]DOMESTIC SYNDICATION[/TD]
[/TR]
[TR]
[TD]207[/TD]
[TD]DOMESTIC THEATRICAL[/TD]
[/TR]
[TR]
[TD]207[/TD]
[TD]LINE INTERNATIONAL RELEASING[/TD]
[/TR]
[TR]
[TD]208[/TD]
[TD]FIRST RUN SYNDICATION[/TD]
[/TR]
[TR]
[TD]209[/TD]
[TD]INTERNATIONAL HOME VIDEO[/TD]
[/TR]
</tbody>[/TABLE]




















Any Help is appreciated on this venture

 

[DanteAmor]

Try the following macro:

Sub Dynamic_Named_Ranges()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim vRange As Range, vData As Range, vUnit As Range, vDescrip As Range
    Dim vName As Variant, cell1 As String, cell2 As String
    '
    Set ws1 = Sheets("Lookups")
    Set ws2 = Sheets("Master")
    '
    'Runs down column A and looks for unique Values
    Set vData = ws1.Range("A1", ws1.Range("A" & Rows.Count).End(xlUp).Address)
    ws1.Range("D1").Resize(vData.Rows.Count).Value = vData.Value
    ws1.Range("D1").Resize(vData.Rows.Count).RemoveDuplicates Columns:=1
    Set vRange = ws1.Range("D2", ws1.Range("D" & Rows.Count).End(xlUp).Address)
    '
    'Create a Named Range using the Unit#
    On Error Resume Next
    ActiveWorkbook.Names("unit").Delete
    On Error GoTo 0
    ActiveWorkbook.Names.Add Name:="unit", RefersTo:="='" & ws1.Name & "'!" & vRange.Address
    '
    '
    'Create validation in Master sheet with only have Unique Unit#
    With ws2.Range("C2").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=unit"
    End With
    '
    'Create the range names
    For Each vUnit In vRange
        vName = IIf(IsNumeric(vUnit.Value), Val(vUnit.Value), vUnit.Value)
        cell1 = vData.Find(vName, LookIn:=xlValues, lookat:=xlWhole, SearchDirection:=xlNext).Offset(, 1).Address
        cell2 = vData.Find(vName, LookIn:=xlValues, lookat:=xlWhole, SearchDirection:=xlPrevious).Offset(, 1).Address
        
        On Error Resume Next
        ActiveWorkbook.Names("u_" & vName).Delete
        On Error GoTo 0
        
        Set vDescrip = Range(cell1, cell2)
        ActiveWorkbook.Names.Add Name:="u_" & vName, RefersTo:="='" & ws1.Name & "'!" & vDescrip.Address
    Next
    
    With ws2.Range("D2").Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=indirect(""u_""&$C$2)"
    End With


End Sub

 

[Johnny Thunder]

Thank you Dante! I am looking into adding the code in now and testing.

 

[Johnny Thunder]

Dante, the code worked perfectly!!!! Thank you so much!

 

[DanteAmor]

I'm glad to help you. Thanks for the feedback.