Data Validation list that pulls from multiple columns in active row?

[jmpatrick]

On my sheet, columns FK:FX of the current row have data. I have a macro that creates a Data Validation list in a specific cell of the currently selected row. Unfortunately, it does not work with the FK:FZ range. If I change it to just FK it works fine. Is it possible to use a range of cells to populate the data validation list?

Here's my code:

Sub ModelSelect()

    Cells(ActiveCell.Row, "FZ").Activate
    ActiveSheet.Unprotect

    aRange = Cells(ActiveCell.Row, "FK:FX")
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=aRange
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
    
    ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True

End Sub

 

[Joe4]

EDIT: Ignore this, it did not work.

 

[Joe4]

Actually, in thinking about this more, I think I would just change your aRange calculation like this:

Dim aRange as String
aRange = "=$FK$" & ActiveCell.Row & ":$FX$" & ActiveCell.Row

and then everything else should work as you have originally written it.

 

[Peter_SSs]

Another possibility is to eliminate aRange altogether with something like this.

Sub ModelSelect_v2()
  Cells(ActiveCell.Row, "FZ").Activate
  ActiveSheet.Unprotect
  With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & ActiveCell.Offset(, -15).Resize(, 14).Address
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
  End With
  ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
End Sub

.. or if you do want to refer specifically to the column letters then the relevant line above could be replaced with this

.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & Intersect(ActiveCell.EntireRow, Columns("FK:FX")).Address

 

[jmpatrick]

Another possibility is to eliminate aRange altogether with something like this.

Sub ModelSelect_v2()
  Cells(ActiveCell.Row, "FZ").Activate
  ActiveSheet.Unprotect
  With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & ActiveCell.Offset(, -15).Resize(, 14).Address
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
  End With
  ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
End Sub

.. or if you do want to refer specifically to the column letters then the relevant line above could be replaced with this

.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & Intersect(ActiveCell.EntireRow, Columns("FK:FX")).Address

This works:

Sub ModelSelect_v2()
  Cells(ActiveCell.Row, "G").Activate
  ActiveSheet.Unprotect
  With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=" & Intersect(ActiveCell.EntireRow, Columns("FK:FX")).Address
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
  End With
  ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
End Sub

Here's my question. All the cells from FK:FX have functions in them that are used to pull the data. Because of this my Validation List drop down has 14 rows even if there are only 4 values. Is it possible to not show these blank values?

 

[jmpatrick]

Looks like I need to FILTER?

 

[Peter_SSs]

Looks like I need to FILTER?

To do that, I think that you will need some helper columns. I have allowed columns GG:GT as helper columns. These helper columns can be hidden.

Sub ModelSelect_v3()
  Dim aRange As String
 
  Cells(ActiveCell.Row, "FZ").Activate
  ActiveSheet.Unprotect
  aRange = Intersect(ActiveCell.EntireRow, Columns("FK:FX")).Address
  Cells(ActiveCell.Row, "GG").Formula2 = Replace("=FILTER(#,#<>"""","""")", "#", aRange)
  With Selection.Validation
    .Delete
    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=GG" & ActiveCell.Row & "#"
    .IgnoreBlank = True
    .InCellDropdown = True
    .InputTitle = ""
    .ErrorTitle = ""
    .InputMessage = ""
    .ErrorMessage = ""
    .ShowInput = True
    .ShowError = True
  End With
  ActiveSheet.Protect DrawingObjects:=False, Contents:=True, Scenarios:=False, AllowFormattingCells:=True, AllowFormattingColumns:=True, AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, AllowDeletingColumns:=True, AllowDeletingRows:=True, AllowSorting:=True, AllowFiltering:=True, AllowUsingPivotTables:=True
End Sub

 

[Peter_SSs]

BTW, you may not need code at all.
If you put this formula in GG2 (or equivalent formula in whatever the first row it might be needed) and copy down as far as you might need ..

=FILTER(FK2:FX2,FK2:FX2<>"","")

.. then in FZ2:FZ?? put the Data Validation as follows ..

.. then the DV lists in columns GG, GH, etc will automatically update if any values in FK:FX change and therefore the relevant DV drop-down lists in column FZ will also automatically update.