How to get dynamic Dropdowns based on the header cell such that the dropdown options are from range, named header cell, in another Source Workbook?

[RajK2005]

Hello everyone,

I am struck with this problem since yesterday and have been unable to find any solution despite all the web searches. Please help me if it is indeed possible.

To better explain the situation:

• We have multiple templates for different product types (400+). We share these files with our clients to fill. Some column headers are common among all templates and some are unique to each template. On an average, each template will have 60+ columns.
• There is no order for the columns in each of those templates since the number of columns are dynamic.
• The values to be entered in most column are restricted to certain values. Others are freetext.
• There is another workbook called "SourceData" where you will find acceptable values for each of these column headers. There are in total around 250+ unique column headers in all 400+ templates. Each of these columns is a named range (name being the header value).
• I would like each cell below any column header in any template to have a dropdown. The dropdown should show options from the SourceData workbook based on the column header.
• The columns for which freetext is allowed, there won't be a column for those in the

Here's a link for 2 sample files: SourceData and Product001
When the client opens both the workbooks (SourceData and Product001) and selects B2 row (Gender) in Product001, I want him to have the dropdown options from Column D (Gender) in SourceData.xlsx. When he moves to C2 (Seasonality), it should show dropdown options from Column E (Seasonality) in SourceData.xlsx. When he moves to Column H (Age Group), it should show dropdown options from column C (Age Group) in SourceData.xlsx.

The only way I know to do is creating dropdown lists one by one. That would mean creating (60*400=) 24000 dropdown lists minimum, one by one.
I know about Dependent Dropdowns and using INDIRECT Option but that would require the named ranges be with-in the same workbook. That would again require me to either copy sourcedata to 200+templates or define 200+ ranges in each of the 400+ templates referencing the sourcedata.

The only experience with VBA is by copy pasting useful VBA codes from web but have no working knowledge of it. I cannot find any way to do it quickly. I need it in another 24 hours. I use Office 365.

Also, should I replace all space in column headers with Underline to make it easier?

Any help is extremely appreciated.

 

[Akuini]

Ok, try this first.
If we are on the right track then I'll explain how it works.
You must put the code in a code module in SourceData workbook, so you'll need to save it as xlsm. The templates still are .xlsx.
Run 'Sub createNamedRange' to define the proper named range then run 'Public Sub AddMasterListToAllWorkbooks".

Option Explicit

Sub createNamedRange()

Dim i As Long, j As Long, n As Long
Dim va, tx As String
Dim c As Range
ThisWorkbook.Worksheets(1).Activate

For Each c In Range("A1", Cells(1, Columns.Count).End(xlToLeft)) 'header
    If c.Offset(1) = "" Then
                'replace space & comma with underscore
        tx = Replace(c.Value, " ", "_")
        tx = Replace(tx, ",", "_")

'    Debug.Print tx
    
    ThisWorkbook.Names.Add Name:=tx, RefersTo:=c.Offset(1)

    
    Else
    
        n = Cells(Rows.Count, c.Column).End(xlUp).Row
        'replace space & comma with underscore
        tx = Replace(c.Value, " ", "_")
        tx = Replace(tx, ",", "_")

'    Debug.Print tx
    
    ActiveWorkbook.Names.Add Name:=tx, RefersTo:=Range(Cells(2, c.Column), Cells(n, c.Column))
    End If

Next

End Sub


Public Sub AddMasterListToAllWorkbooks()
    
    Dim sourceSheet As Worksheet
    Dim folder      As String, filename As String
    Dim destinationWorkbook As Workbook
    
    Dim templatename As String
    Dim TemplateSheet As Worksheet
    Dim rng         As Range
    Dim tbOb        As ListObject
    
Dim i As Long, j As Long, n As Long, rc As Long, h As Long, table_size As Long
Dim c As Range, f As Range
Dim tx As String
Dim va, x
Dim d As Object

    table_size = 10 'set table's number of row > adjust as needed

    'Worksheet in active workbook to be copied as a new sheet to the workbooks
    
    Set sourceSheet = ThisWorkbook.Worksheets("SourceData")
    
    With sourceSheet
        va = .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft))
    End With
    
    Set d = CreateObject("scripting.dictionary"):    d.CompareMode = vbTextCompare
    
    For Each x In va
        d(x) = Empty
    Next

    'Folder containing the templates
    
    folder = "C:\Users\Username\Downloads\Templates\Drive\"
'        folder = "D:\zzz\try\"
   
    filename = Dir(folder & "*.xls*", vbNormal)
    While Len(filename) <> 0
        Debug.Print folder & filename
        Set destinationWorkbook = Workbooks.Open(folder & filename)
        sourceSheet.Copy After:=destinationWorkbook.Sheets(1)
        
        'Format Template as a Table
        
       Set TemplateSheet = destinationWorkbook.Worksheets(1)
        
        TemplateSheet.Activate
        
        rc = Cells(1, Columns.Count).End(xlToLeft).Column
        Set rng = Range(Cells(1, 1), Cells(table_size, rc))
        
        Set tbOb = TemplateSheet.ListObjects.Add(xlSrcRange, rng, , xlYes)
        tbOb.Name = "DynamicTable1"
        tbOb.TableStyle = "TableStyleMedium2"
        
        
'        Debug.Print tbOb.Range.Address
       
        For Each c In tbOb.HeaderRowRange
            h = h + 1
            
            If d.Exists(c.Value) Then
                Set f = c.Offset(1).Resize(table_size - 1)
                            tx = Replace(c.Value, " ", "_")
                            tx = "=" & Replace(tx, ",", "_")
                                            
                With f.Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=tx
                End With
               
            End If
        Next
      
        destinationWorkbook.Close True
        filename = Dir()        ' Get next matching file
    Wend
    
End Sub

Note: Seasonality & Storage Care are in SourceData, so why you don't mark them as mandatory?
the result:

Product001-result

MediaFire is a simple to use free service that lets you put all your photos, documents, music, and video in a single place so you can access them anywhere and share them everywhere.

www.mediafire.com

 

[RajK2005]

Ok, try this first.
If we are on the right track then I'll explain how it works.
You must put the code in a code module in SourceData workbook, so you'll need to save it as xlsm. The templates still are .xlsx.
Run 'Sub createNamedRange' to define the proper named range then run 'Public Sub AddMasterListToAllWorkbooks".

Option Explicit

Sub createNamedRange()

Dim i As Long, j As Long, n As Long
Dim va, tx As String
Dim c As Range
ThisWorkbook.Worksheets(1).Activate

For Each c In Range("A1", Cells(1, Columns.Count).End(xlToLeft)) 'header
    If c.Offset(1) = "" Then
                'replace space & comma with underscore
        tx = Replace(c.Value, " ", "_")
        tx = Replace(tx, ",", "_")

'    Debug.Print tx
  
    ThisWorkbook.Names.Add Name:=tx, RefersTo:=c.Offset(1)

  
    Else
  
        n = Cells(Rows.Count, c.Column).End(xlUp).Row
        'replace space & comma with underscore
        tx = Replace(c.Value, " ", "_")
        tx = Replace(tx, ",", "_")

'    Debug.Print tx
  
    ActiveWorkbook.Names.Add Name:=tx, RefersTo:=Range(Cells(2, c.Column), Cells(n, c.Column))
    End If

Next

End Sub


Public Sub AddMasterListToAllWorkbooks()
  
    Dim sourceSheet As Worksheet
    Dim folder      As String, filename As String
    Dim destinationWorkbook As Workbook
  
    Dim templatename As String
    Dim TemplateSheet As Worksheet
    Dim rng         As Range
    Dim tbOb        As ListObject
  
Dim i As Long, j As Long, n As Long, rc As Long, h As Long, table_size As Long
Dim c As Range, f As Range
Dim tx As String
Dim va, x
Dim d As Object

    table_size = 10 'set table's number of row > adjust as needed

    'Worksheet in active workbook to be copied as a new sheet to the workbooks
  
    Set sourceSheet = ThisWorkbook.Worksheets("SourceData")
  
    With sourceSheet
        va = .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft))
    End With
  
    Set d = CreateObject("scripting.dictionary"):    d.CompareMode = vbTextCompare
  
    For Each x In va
        d(x) = Empty
    Next

    'Folder containing the templates
  
    folder = "C:\Users\Username\Downloads\Templates\Drive\"
'        folder = "D:\zzz\try\"
 
    filename = Dir(folder & "*.xls*", vbNormal)
    While Len(filename) <> 0
        Debug.Print folder & filename
        Set destinationWorkbook = Workbooks.Open(folder & filename)
        sourceSheet.Copy After:=destinationWorkbook.Sheets(1)
      
        'Format Template as a Table
      
       Set TemplateSheet = destinationWorkbook.Worksheets(1)
      
        TemplateSheet.Activate
      
        rc = Cells(1, Columns.Count).End(xlToLeft).Column
        Set rng = Range(Cells(1, 1), Cells(table_size, rc))
      
        Set tbOb = TemplateSheet.ListObjects.Add(xlSrcRange, rng, , xlYes)
        tbOb.Name = "DynamicTable1"
        tbOb.TableStyle = "TableStyleMedium2"
      
      
'        Debug.Print tbOb.Range.Address
     
        For Each c In tbOb.HeaderRowRange
            h = h + 1
          
            If d.Exists(c.Value) Then
                Set f = c.Offset(1).Resize(table_size - 1)
                            tx = Replace(c.Value, " ", "_")
                            tx = "=" & Replace(tx, ",", "_")
                                          
                With f.Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=tx
                End With
             
            End If
        Next
    
        destinationWorkbook.Close True
        filename = Dir()        ' Get next matching file
    Wend
  
End Sub

Note: Seasonality & Storage Care are in SourceData, so why you don't mark them as mandatory?
the result:

Product001-result

MediaFire is a simple to use free service that lets you put all your photos, documents, music, and video in a single place so you can access them anywhere and share them everywhere.

www.mediafire.com

This works. Thank you so so much. I was so stressed out because of this. Thanks a lot.

If you don't mind, would you explain how you figured it out so I understand the code as well?

Also, if you don't mind, can I ask for 2 more tweaks?

1) To remove the dropdowns from the 2nd row as well. It just is an indicator whether it's mandatory or not. I can add the following code but if you have anything more efficient, we can add that as part of the code.

Sub Macro1()
    Rows("2:2").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
End Sub

2) Any simpler way to sort the Data in the sourcedata sheet. There are like 233 columns. The data in each column ranges from a few rows to 10s of thousands. 7 of them are in 100Ks. And it's not at all sorted alphabetically (Honestly, I am surprised our tech team even allowed this).

I found this but it doesn't work. The Excel just goes into not responding and Crashes.

I thought maybe because my data is large but it doesn't work even with the sample file I shared. This is not a necessity but would be preferred if you don't mind.

Also, does my code in post #10 to update the sourcedata continue to work after I add the sourcedata to each template using your code? Or does it need any modifications now?

Once again, thanks a lot. Really really grateful.

Also, your code also solves another issue I was encountering. The sheet names were based on file names but if the file name was more than 31 characters, it was trimmed to 31 characters. In those cases, my code would break as it depended on filename to choose the sheet. Thanks for that as well.

 

[Akuini]

Ok, but I kind of busy at the moment, so I'll come back tomorrow.

 

[RajK2005]

Ok, but I kind of busy at the moment, so I'll come back tomorrow.

Sure. No Worries. No hurry.

 

[Akuini]

Ok, here's how it works:

1. Run Sub sort_SourceData to sort SourceData.
2. Run 'Sub createNamedRange' to define the proper named ranges
3. Run 'Public Sub AddMasterListToAllWorkbooks' to create new templates.

NOTES:
1. I don't use Indirect as data-validation formula, instead I use a fixed named range. It will make the workbook operates faster.

2. I set table size to 10 rows in this part:

table_size = 10 'set table's number of row > adjust as needed

do not set too many rows, in your code earlier you set the table up to last row of the sheet (i.e row 1048576)!!!. That will make the sheet significantly slow.
Assuming the user know how to expand the table manually then 10 or 100 rows is enough.

3. Data validation start at row 3 per your request.

Set f = c.Offset(2).Resize(table_size - 2) 'dropdown start at row 3

4. Whenever you update data in SourceData.xlsm, you need to run 'Sub createNamedRange' to redefine the proper named ranges.
I suggest you keep the original templates in a backup folder, so when you need to update the templates you just need to remove all the new templates & replace them with the original ones. This way you can then run 'Public Sub AddMasterListToAllWorkbooks' without problem.

The code:

Option Explicit

Sub createNamedRange()

Dim i As Long, j As Long, n As Long
Dim va, tx As String
Dim c As Range
ThisWorkbook.Worksheets(1).Activate

For Each c In Range("A1", Cells(1, Columns.Count).End(xlToLeft)) 'header
    If c.Offset(1) = "" Then
                'replace space & comma with underscore
        tx = Replace(c.Value, " ", "_")
        tx = Replace(tx, ",", "_")

'    Debug.Print tx
    
    ThisWorkbook.Names.Add Name:=tx, RefersTo:=c.Offset(1)

    
    Else
    
        n = Cells(Rows.Count, c.Column).End(xlUp).Row
        'replace space & comma with underscore
        tx = Replace(c.Value, " ", "_")
        tx = Replace(tx, ",", "_")

'    Debug.Print tx
    
    ActiveWorkbook.Names.Add Name:=tx, RefersTo:=Range(Cells(2, c.Column), Cells(n, c.Column))
    End If

Next

End Sub


Public Sub AddMasterListToAllWorkbooks()
    
    Dim sourceSheet As Worksheet
    Dim folder      As String, filename As String
    Dim destinationWorkbook As Workbook
    
    Dim templatename As String
    Dim TemplateSheet As Worksheet
    Dim rng         As Range
    Dim tbOb        As ListObject
    
Dim i As Long, j As Long, n As Long, rc As Long, h As Long, table_size As Long
Dim c As Range, f As Range
Dim tx As String
Dim va, x
Dim d As Object

    table_size = 10 'set table's number of row > adjust as needed

    'Worksheet in active workbook to be copied as a new sheet to the workbooks
    
    Set sourceSheet = ThisWorkbook.Worksheets("SourceData")
    
    With sourceSheet
        va = .Range("A1", .Cells(1, .Columns.Count).End(xlToLeft))
    End With
    
    Set d = CreateObject("scripting.dictionary"):    d.CompareMode = vbTextCompare
    
    For Each x In va
        d(x) = Empty
    Next

    'Folder containing the templates
    
    folder = "C:\Users\Username\Downloads\Templates\Drive\"
'        folder = "D:\zzz\try\"
   
    filename = Dir(folder & "*.xls*", vbNormal)
    While Len(filename) <> 0
'        Debug.Print folder & filename
        Set destinationWorkbook = Workbooks.Open(folder & filename)
        sourceSheet.Copy After:=destinationWorkbook.Sheets(1)
        
        'Format Template as a Table
        
       Set TemplateSheet = destinationWorkbook.Worksheets(1)
        
        TemplateSheet.Activate
        
        rc = Cells(1, Columns.Count).End(xlToLeft).Column
        Set rng = Range(Cells(1, 1), Cells(table_size, rc))
        
        Set tbOb = TemplateSheet.ListObjects.Add(xlSrcRange, rng, , xlYes)
        tbOb.Name = "DynamicTable1"
        tbOb.TableStyle = "TableStyleMedium2"
        
        
'        Debug.Print tbOb.Range.Address
       
        For Each c In tbOb.HeaderRowRange
            h = h + 1
            
            If d.Exists(c.Value) Then
                Set f = c.Offset(2).Resize(table_size - 2) 'dropdown start at row 3
                            tx = Replace(c.Value, " ", "_")
                            tx = "=" & Replace(tx, ",", "_")
                                            
                With f.Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=tx
                End With
               
            End If
        Next
      
        destinationWorkbook.Close True
        filename = Dir()        ' Get next matching file
    Wend
    
End Sub

Sub sort_SourceData()
'to sort Sheets("SourceData")
Dim c As Range
Application.ScreenUpdating = False
With Sheets("SourceData")

        For Each c In .Range("A1", Cells(1, Columns.Count).End(xlToLeft))
            With c.EntireColumn
               .Sort Key1:=.Cells(1), Order1:=xlAscending, Header:=xlYes
            End With
        Next
End With
Application.ScreenUpdating = True
End Sub

 

[RajK2005]

This works great. I have been able to do it for all 412 templates without any issues. You have been really helpful and it works so efficiently. Did all the templates in like 40 minutes.

Thanks a lot.

 

[Akuini]

You're welcome, glad to help & thanks for the feedback.

The data in each column ranges from a few rows to 10s of thousands. 7 of them are in 100Ks.

Since you have a big list in the data validation, I suggest you to use an add-in to speed up data entry process.
I created an Excel add-in for searchable data validation (with combobox) , called "Search deList".
Its function is to speed up the search in the data validation list. It works on multiple cells. In any cell that has data validation (with List type) pressing ALT+RIGHT will open a User Form with a combobox. You can type multiple keywords (separated by a space) in the combobox to search items on the list.
By using this add-in, you don't need VBA to have this searchable combobox, it works on any cells that have data validation on any workbook.
I share this add-in here:

I created an Excel add-in called “Search deList”, to create searchable data validation

I created an add-in called “Search deList”, and I share it as a freeware. Its function is to speed up searching in data validation list. In any cell that has data validation (with List type) pressing ALT+RIGHT will open a Userform with a combobox. You can type multiple keywords (separated by a...

www.mrexcel.com

 

[RajK2005]

That makes it even better. My Colleague did ask me to see if I can implement the option where dropdown results show up as you type since there are way too many options.
I said that can be done but I have no idea how to do it and it will be a big deal if I get dropdowns added as it is. So we dropped that.

Your solution is very simple. I will pitch it to my colleagues and see if we can use that. Not sure if the clients will agree to installing Add-ins and if their version even supports it (AFAIK, Add-ins are supported after 2007). Anyway, it's good to have options.

Once again, thanks for all the help.

 

[Akuini]

Not sure if the clients will agree to installing Add-ins and if their version even supports it (AFAIK, Add-ins are supported after 2007).

I understand that some companies don't allow VBA because of the potential dangers. My suggestion would be to ask the IT department to check the Search deList add-in to see if it's safe or not. The code in the add-in is not protected by any password, so they can easily check it.
I believe it works on Excel 2007 or later.

 

[RajK2005]

I understand that some companies don't allow VBA because of the potential dangers. My suggestion would be to ask the IT department to check the Search deList add-in to see if it's safe or not. The code in the add-in is not protected by any password, so they can easily check it.
I believe it works on Excel 2007 or later.

That's a good suggestion. And our team is pretty relaxed about installing 3rd party softwares. So, they mostly will approve. Will see what happens.