英文:

How do I get drop-downs with non-selectable sub-headings and empty rows ignored in Excel 2019?

问题

I have the area for the list items in the drop-downs on another worksheet, in adjacent cells from top to bottom except for some rows (so there are blank lines between some list items). Some more rows in this range might sometimes be empty though, so I need Excel to ignore these rows when displaying the list items in the drop-downs on Sheet B.

在另一个工作表上，我有下拉列表项的区域，这些项在相邻的单元格中从上到下排列，除了一些行（因此在一些列表项之间有空行）。但是，这个范围内的一些行有时可能为空，因此当在Sheet B上显示下拉列表项时，我需要Excel忽略这些行。

In the source range on Sheet A, there will be sub-headings (e.g. "Fruits", "Vegetables" etc.) that also should be displayed on Sheet B in the drop-downs (but it should not be possible to select any of the sub-heading themselves).

在Sheet A上的源范围中，将有子标题（例如“水果”，“蔬菜”等），这些子标题也应该在Sheet B上的下拉列表中显示（但不应该能够选择任何子标题本身）。

And the range might become a few rows bigger or smaller.

而且，范围可能会变得稍大或稍小。

How do I best go about to accomplish above? Is VBA needed?

我应该如何最好地完成上述任务？是否需要使用VBA？

The drop-downs should be on Sheet B, in a sample Excel that I would like to upload here in the range A4:G10.

下拉列表应该位于Sheet B上，在一个示例Excel文件中，我想要上传到这里的范围是A4:G10。

And the source range of the drop-down list items are on Sheet A, in the sample Excel that I would like to upload here in the range A8:A20 (the sub-headings in that range are "Vegetable" and "Fruit", cells A8 and A13; it should not be possible to select these - they should only be displayed in the drop-downs).

下拉列表项的源范围位于Sheet A上，在我想要上传的示例Excel文件中，该范围是A8:A20（该范围中的子标题为“蔬菜”和“水果”，分别位于单元格A8和A13；不应该能够选择这些 - 它们应该只显示在下拉列表中）。

The problem is with the blank rows and that the sub-headings should be displayed in the drop-downs but not selectable. So I hope to get the sub-headings displayed on Sheet B in the dropdowns (non-selectable sub-headings) and have a dynamic range on Sheet A (the source for the drop-downs), a range which is now A8:A20 but might be longer or smaller. I hope also to find a solution which accommodates for the possibility that some cells sometimes are empty in the source on Sheet A (like now, where cells A13, A14, A19, A20 are empty in the range A8:A20).

问题出在空行上，子标题应该显示在下拉列表中但不能选择。因此，我希望在Sheet B上的下拉列表中显示子标题（不可选择的子标题），并在Sheet A上有一个动态范围（下拉列表的源），该范围现在是A8:A20，但可能更长或更短。我还希望找到一个解决方案，以适应Sheet A上源的某些单元格有时为空的可能性（就像现在，在范围A8:A20中的单元格A13、A14、A19、A20为空）。

英文:

I have the area for the list items in the drop-downs on another worksheet, in adjacent cells from top to bottom except for some rows (so there are blank lines between some list items). Some more rows in this range might sometimes be empty though, so I need Excel to ignore these rows when displaying the list items in the drop-downs on Sheet B.

In the source range on Sheet A, there will be sub-headings (e.g. "Fruits", "Vegetables" etc.) that also should be displayed on Sheet B in the drop-downs (but it should not be possible to select any of the sub-heading themselves).

And the range might become a few rows bigger or smaller.

How do I best go about to accomplish above? Is VBA needed?

The drop-downs should be on Sheet B, in a sample Excel that I would like to upload here in the range A4:G10.

And the source range of the drop-down list items are on Sheet A, in the sample Excel that I would like to upload here in the range A8:A20 (the sub-headings in that range are "Vegetable" and "Fruit", cells A8 and A13; it should not be possible to select these - they should only be displayed in the drop-downs).

The problem is with the blank rows and that the sub-headings should be displayed in the drop-downs but not selectable. So I hope to get the sub-headings displayed on Sheet B in the dropdowns (non-selectable sub-headings) and have a dynamic range on Sheet A (the source for the drop-downs), a range which is now A8:A20 but might be longer or smaller. I hope also to find a solution which accommodates for the possibility that some cells sometimes are empty in the source on Sheet A (like now, where cells A13, A14, A19, A20 are empty in the range A8:A20).

答案1

得分: 0

Here's the translated content you requested:

"It's All done. Please download it to check it out.

The sample file, Sheet A cell O4 still has formula data in it, and

> … (the sub-headings in that range are "Vegetable" and "Fruit", cells A8 and A13 …

in this file is A15, not A13. I've ignored both of them.

Remark:

The two name range might be longer or smaller, as long as you are adding and removing cells from these two name ranges, and not from their boundaries. Or you can modify it from the following two constant values in the program code.

Public Const DropDownsSourceRangeDefaultAddress As String = "$A$8:$A$20"
Public Const DropDownsRangeAddress As String = "$A$4:$G$10"

'this one will get the changed range by user
Public DropDownsSourceRangeAddress As String

You should download it to test it to make sure it is the effect you want. After downloading, remember to enable the macro. If you can get an error message when some sub-heading is selected in a drop-down,

it means that the file's program is working properly on your end, just like it is on my end.
Or you will see some like:


(I only have the traditional Chinese version!)
then you have to enable the macro just click the button in the green circle in the image above. Or put the file in the Trusted directory to run macros before opening it, please reference these articles

Enable or disable macros in Microsoft 365 files

Run a macro

Change macro security settings in Excel

Otherwise, the program will not run or run in error. If you are still unsure, you will have to copy the codes I posted below and add them to the correct location in the Excel .xlsm or .xlsb file for the program to run properly. (Modules in the general module (模組) and objects in the class module (物件) and name them like) :

press Alt + F11 to open this VBE

Demo: Add code to your file. (How to move these four pieces of VBA code below to your real, big Excel workbook.) see also

code

Module "DropDownOP"

(Original Name is "Module1")

Option Explicit
Rem Each of the following conditions is subject to your discretion. For now, it looks like the conditions you invented in Stackoverflow
Rem Each condition can be specified by the following constants (i.e. the value in double quotes), without having to enter the code to make changes
'https://stackoverflow.com/questions/76268864/how-do-i-get-drop-downs-with-non-selectable-sub-headings-and-empty-rows-ignored
Public Const DropDownsSourceRangeName As String = "Food_items"
Public Const DropDownsRangeName As String = "DropDownsRange"
Public Const DropDownsSourceSheetName As String = "Sheet A"
Public Const DropDownsSheetName As String = "Sheet B"
Public Const DropDownsSourceRangeDefaultAddress As String = "$A$8:$A$20"
Public Const DropDownsRangeAddress As String = "$A$4:$G$10"

'this one will get the changed range by user
Public DropDownsSourceRangeAddress As String

Sub AddNamedRange()
    'DeleteNamedRanges
    DropDownsSourceRangeAddress = CheckDropDownsSourceNamedRange
    If DropDownsSourceRangeAddress <> "" Then
        ThisWorkbook.Names(DropDownsSourceRangeName).RefersTo = "='" + DropDownsSourceSheetName + "'!" + DropDownsSourceRangeAddress
    Else
        ThisWorkbook.Names.Add Name:=DropDownsSourceRangeName, RefersTo:="='" + DropDownsSourceSheetName + "'!" + DropDownsSourceRangeDefaultAddress
    End If
    ThisWorkbook.Names.Add Name:=DropDownsRangeName, RefersTo:="='" + DropDownsSheetName + "'!" + DropDownsRangeAddress
End Sub

Function CheckDropDownsSourceNamedRange() As String
    On Error GoTo ErrorHandler
    Dim n As Name
    For Each n In ThisWorkbook.Names
        If n.Name = DropDownsSourceRangeName Then
            CheckDropDownsSourceNamedRange = n.RefersToRange.Address
            Exit Function
        End If
    Next n

    Exit Function

ErrorHandler:
    MsgBox "An error occurred: " & Err.Description
End Function

Sub DeleteNamedRanges()
    On Error GoTo ErrorHandler
    Dim i As Long
    For i = ThisWorkbook.Names.Count To 1 Step -1
        Select Case ThisWorkbook.Names(i).Name
            Case DropDownsSourceRangeName, DropDownsRangeName
                ThisWorkbook.Names(i).Delete
            Case Else
                If InStr(ThisWorkbook.Names(i).Name, DropDownsSourceRangeName)

<details>
<summary>英文:</summary>

It&#39;s All done. Please [download it](https://docs.google.com/spreadsheets/d/1tDIlGupA7_e7B9cpmOqL7zTbtw_xl0hw/edit?usp=sharing&amp;ouid=106108182093734588005&amp;rtpof=true&amp;sd=true)  to check it out.

The [sample file](https://files.fm/u/47m76d9de), Sheet A cell **O4** still has formula data in it, and 

&gt; … (the sub-headings in that range are &quot;Vegetable&quot; and &quot;Fruit&quot;, cells A8 and A13 …

in this file is A15, not A13. I&#39;ve ignored both of them. 

### Remark:

The two name range **might be longer or smaller**, as long as you are adding and removing cells from these two name ranges, and not from their boundaries. Or you can modify it from the following two constant values in the program code.

```vba
Public Const DropDownsSourceRangeDefaultAddress As String = &quot;$A$8:$A$20&quot;
Public Const DropDownsRangeAddress As String = &quot;$A$4:$G$10&quot;

&#39;this one will get the changed range by user
Public DropDownsSourceRangeAddress As String

You should download it to test it to make sure it is the effect you want. After downloading, remember to enable the macro. If you can get an error message when some sub-heading is selected in a drop-down,

it means that the file's program is working properly on your end, just like it is on my end.
Or you will see some like:


(I only have the traditional Chinese version!)
then you have to enable the macro just click the button in the green circle in the image above.
Or put the file in the Trusted directory to run macros before opening it, please reference these articles

Enable or disable macros in Microsoft 365 files

Run a macro

Change macro security settings in Excel

Otherwise, the program will not run or run in error. If you are still unsure, you will have to copy the codes I posted below and add them to the correct location in the Excel .xlsm or .xlsb file for the program to run properly. (Modules in the general module (模組) and objects in the class module (物件) and name them like) :

press Alt + F11 to open this VBE

Demo: Add code to your file. (How to move these four pieces of VBA code below to your real, big Excel workbook.) see also

code

Module "DropDownOP"

(Original Name is "Module1")

Option Explicit
Rem Each of the following conditions is subject to your discretion. For now, it looks like the conditions you invented in  Stackoverflow
Rem Each condition can be specified by the following constants (i.e. the value in double quotes), without having to enter the code to make changes
'https://stackoverflow.com/questions/76268864/how-do-i-get-drop-downs-with-non-selectable-sub-headings-and-empty-rows-ignored
Public Const DropDownsSourceRangeName As String = "Food_items"
Public Const DropDownsRangeName As String = "DropDownsRange"
Public Const DropDownsSourceSheetName As String = "Sheet A"
Public Const DropDownsSheetName As String = "Sheet B"
Public Const DropDownsSourceRangeDefaultAddress As String = "$A$8:$A$20"
Public Const DropDownsRangeAddress As String = "$A$4:$G$10"

'this one will get the changed range by user
Public DropDownsSourceRangeAddress As String


Sub AddNamedRange()
    'DeleteNamedRanges
    DropDownsSourceRangeAddress = CheckDropDownsSourceNamedRange
    If DropDownsSourceRangeAddress <> "" Then
        ThisWorkbook.Names(DropDownsSourceRangeName).RefersTo = "='" + DropDownsSourceSheetName + "'!" + DropDownsSourceRangeAddress
    Else
        ThisWorkbook.Names.Add Name:=DropDownsSourceRangeName, RefersTo:="='" + DropDownsSourceSheetName + "'!" + DropDownsSourceRangeDefaultAddress
    End If
    ThisWorkbook.Names.Add Name:=DropDownsRangeName, RefersTo:="='" + DropDownsSheetName + "'!" + DropDownsRangeAddress
End Sub

Function CheckDropDownsSourceNamedRange() As String
    On Error GoTo ErrorHandler
    Dim n As Name
    For Each n In ThisWorkbook.Names
        If n.Name = DropDownsSourceRangeName Then
            CheckDropDownsSourceNamedRange = n.RefersToRange.Address
            Exit Function
        End If
    Next n
    
    Exit Function
    
ErrorHandler:
    MsgBox "An error occurred: " & Err.Description
End Function

Sub DeleteNamedRanges()
    On Error GoTo ErrorHandler
    Dim i As Long
    For i = ThisWorkbook.Names.Count To 1 Step -1
        Select Case ThisWorkbook.Names(i).Name
            Case DropDownsSourceRangeName, DropDownsRangeName
                ThisWorkbook.Names(i).Delete
            Case Else
                If InStr(ThisWorkbook.Names(i).Name, DropDownsSourceRangeName) Or _
                    InStr(ThisWorkbook.Names(i).Name, DropDownsRangeName) Then _
                        ThisWorkbook.Names(i).Delete
        End Select
    Next i
    
    Exit Sub
    
ErrorHandler:
    MsgBox "An error occurred: " & Err.Description
End Sub

Sub SetDropDownList()
   
   'set drop-downs
   Dim cell As Range, strFormula1 As String
   strFormula1 = getFormula1
   For Each cell In Sheets(DropDownsSheetName).Range(DropDownsRangeName).Cells
     
     'clear cells' value ,If needed
     'cell.Clear
     
      With cell.Validation
          .Delete 'clear existd Validation rules
          .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                        Operator:=xlBetween, _
                        Formula1:=strFormula1
          .IgnoreBlank = True
          .InCellDropdown = True
          .InputTitle = "Select a value"
          .ErrorTitle = "Invalid Value"
          .InputMessage = "Please select a value from the list."
          .ErrorMessage = "Please select a valid value from the list."
          .ShowInput = True
          .ShowError = True
       End With
    Next cell
End Sub
Function getFormula1() As String
    Dim f As String, arr, e
    arr = Application.WorksheetFunction.Transpose(Range(DropDownsSourceRangeName))
    For Each e In arr
        If Not VBA.IsEmpty(e) Then
            f = f & e & ","
        End If
    Next
    f = Left(f, Len(f) - 1)
    getFormula1 = f
End Function

Module "SheetsOP"

Option Explicit

'https://stackoverflow.com/a/76238510/8249058
Sub Worksheet_Change(ByVal Target As Range)
    If Target = "" Then Exit Sub
    Dim c As Range
    Set c = ActiveCell
    Dim Cancel As Boolean
    Cancel = BeforeCellChange(Target)
    If Cancel Then
        MsgBox "You can't select this one: '" + Target.Value + "'" + vbCr + vbCr + vbTab + "Try again. ", vbCritical
        Application.EnableEvents = False
        Target.Value = ""
        Application.EnableEvents = True
        c.Offset(Target.Row - c.Row, Target.Column - c.Column).Select
    End If
End Sub
Function BeforeCellChange(ByVal Target As Range) As Boolean
    Rem set your rule
    Dim dictSubHeadings As Object, cell As Range
    Set dictSubHeadings = CreateObject("Scripting.Dictionary")
    For Each cell In ThisWorkbook.Sheets(DropDownOP.DropDownsSourceSheetName).Range(DropDownOP.DropDownsSourceRangeName)
        'if it is sub-headings
        If cell.Font.Underline And cell.Font.Bold And VBA.Left(cell.Value, 1) = "*" And VBA.Right(cell.Value, 1) = "*" Then 
            dictSubHeadings(cell.Value) = cell.Value
        End If
    Next cell
    If dictSubHeadings.exists(Target.Value) Then BeforeCellChange = True
    dictSubHeadings.RemoveAll
    Set dictSubHeadings = Nothing
End Function

object Sheet2 "Sheet B"

Option Explicit

Private Sub Worksheet_Activate()
    'automatically update the dropdown list values when switching to Sheet B
    DropDownOP.SetDropDownList
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    SheetsOP.Worksheet_Change Target
End Sub

object "ThisWorkbook"

Option Explicit

Private Sub Workbook_Open()
    AddNamedRange
End Sub