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

Column A	Column B
Unit#	Unit Descriptions
201	OTHER ELIMS.-Default
201	OTHER ELIMS.- Games Lic
203	DOMESTIC DIGITAL DISTRIBUTION
204	INTERNATIONAL DIGITAL DIST.
205	DOMESTIC HOME VIDEO
206	DOMESTIC SYNDICATION
207	DOMESTIC THEATRICAL
207	LINE INTERNATIONAL RELEASING
208	FIRST RUN SYNDICATION
209	INTERNATIONAL HOME VIDEO

<tbody>
</tbody>

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.