Show/Hide Dropdown List

[tm1274]

Hello Everyone,

I have been searching but have not been able to find a way to show or hide an in cell dropdown list based upon the value in an adjacent cell. To explain it simply, if A1 = 1 then Cell B1 should show the dropdown list however if A1 is blank or empty then B1 should not show the dropdown list.
The ultimate goal would be, if cell A1 equals a vaue of 1-15 entered and then the adjacent cells B1:P1 would show the dropdown list based upn the number entered. So if 5 were entered, then B1,C1,D1,E1 and F1 would show the dropdown and all others (G1:P1) would not show the list. As the number increases then the list appears in more cells in row 1 but as the number decreases then the list only appears in the "quantity" entered into cell A1. Not sure if I am explaining it well enough.
I keep hitting a wall on making it show or hide based upon if a specific value is entered in cell A1. Does anyone have any suggestion on how to accomplish this or any place online I can go to to learn the simplest method of making this work?

 

[kevin9999]

The following is based on your validation list being called "Options" - change this to whatever you currently use. It is a worksheet change event which needs to be placed in the sheet code area of whatever sheet you are using (right-click the sheet tab/select view code - place the code in the code window that appears). You cab put a limit on the entry in cell A1 as any whole number from 1-15. Once you add the code, save the file & try it.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("A1"), Target) Is Nothing Then
        Application.EnableEvents = False
        Range("B1:P1").Validation.Delete
        Dim cols As Long
        cols = Range("A1").Value
        If cols > 0 Then
            With Range("B1")
                .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                Formula1:="=Options"
                .Copy
                .Resize(, cols).PasteSpecial xlPasteValidation
                Application.CutCopyMode = False
            End With
        End If
        Application.EnableEvents = True
    End If
End Sub

 

[tm1274]

The following is based on your validation list being called "Options" - change this to whatever you currently use. It is a worksheet change event which needs to be placed in the sheet code area of whatever sheet you are using (right-click the sheet tab/select view code - place the code in the code window that appears). You cab put a limit on the entry in cell A1 as any whole number from 1-15. Once you add the code, save the file & try it.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("A1"), Target) Is Nothing Then
        Application.EnableEvents = False
        Range("B1:P1").Validation.Delete
        Dim cols As Long
        cols = Range("A1").Value
        If cols > 0 Then
            With Range("B1")
                .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                Formula1:="=Options"
                .Copy
                .Resize(, cols).PasteSpecial xlPasteValidation
                Application.CutCopyMode = False
            End With
        End If
        Application.EnableEvents = True
    End If
End Sub

That seemed to work well but there is one issue. When a selection is made then the value in the trigger cell "A1" changes to zero or blank, the value that is selected in the dropdown list does not clear. Did I do something wrong or is there a way to clear the dropdown value when cell A1 is either blank or zero?

 

[kevin9999]

Try this (slight addition)

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("A1"), Target) Is Nothing Then
        Application.EnableEvents = False
        With Range("B1:P1")
            .Validation.Delete
            .ClearContents
        End With
        Dim cols As Long
        cols = Range("A1").Value
        If cols > 0 Then
            With Range("B1")
                .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                Formula1:="=Options"
                .Copy
                .Resize(, cols).PasteSpecial xlPasteValidation
                Application.CutCopyMode = False
            End With
        End If
        Application.EnableEvents = True
    End If
End Sub

 

[tm1274]

Try this (slight addition)

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("A1"), Target) Is Nothing Then
        Application.EnableEvents = False
        With Range("B1:P1")
            .Validation.Delete
            .ClearContents
        End With
        Dim cols As Long
        cols = Range("A1").Value
        If cols > 0 Then
            With Range("B1")
                .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                Formula1:="=Options"
                .Copy
                .Resize(, cols).PasteSpecial xlPasteValidation
                Application.CutCopyMode = False
            End With
        End If
        Application.EnableEvents = True
    End If
End Sub

That worked perfectly. Thank you for your help. I have been trying to get this to work for hours and although I have played with vba in the past, I have never gotten a really good grasp on it.
I do have a couple questions, first, in your opinion would it be better to try to code a cell color (yellow) into the same vba so the user knows which cells need selections made or would it be better to just use conditional formatting? Also, would this code work if I changed the range from the horizontal row range (B1:P1) to a vertical column range (B1:B15), or would there need to be other parts of the vba that need changed to make this work?

 

[kevin9999]

Personal opinion only, I would use VBA to do the coloring. Like this:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("A1"), Target) Is Nothing Then
        Application.EnableEvents = False
        With Range("B1:P1")
            .Validation.Delete
            .ClearContents
            .Interior.Color = xlNone
        End With
        Dim cols As Long
        cols = Range("A1").Value
        If cols > 0 Then
            With Range("B1")
                .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                Formula1:="=Options"
                .Copy
                .Resize(, cols).PasteSpecial xlPasteValidation
                Application.CutCopyMode = False
                .Resize(, cols).Interior.Color = vbYellow
                .Select
            End With
        End If
        Application.EnableEvents = True
    End If
End Sub

It wouldn't take much to change the code to specify the range B1:B15, like this:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Range("A1"), Target) Is Nothing Then
        Application.EnableEvents = False
        With Range("B1:B15")
            .Validation.Delete
            .ClearContents
            .Interior.Color = xlNone
        End With
        Dim cols As Long
        cols = Range("A1").Value
        If cols > 0 Then
            With Range("B1")
                .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                Formula1:="=Options"
                .Copy
                .Resize(cols).PasteSpecial xlPasteValidation
                Application.CutCopyMode = False
                .Resize(cols).Interior.Color = vbYellow
                .Select
            End With
        End If
        Application.EnableEvents = True
    End If
End Sub

 

[tm1274]

Hello Kevin9999, your solution worked perfectly and thank you for your input on the cell color and changing to horizontal. I came here looking for help and you certainly helped. The code you have given me I will study to see if I can become more proficient using vba. Anyhow, just wanted to say thanks.

 

[kevin9999]

You're more than welcome, and thank you for the feedback.

 

[tm1274]

Hello kevin9999,
My spreadsheet has evolved a little in trying to get the same dropdown list, background color and (now) borders around the cells to work in both horizontal and vertical. I used the code you sent with a new worksheet change called Worksheet_Change_2, but that doesnt work. I really had this messed up between trying to add ".borderaround" the cells and the code to add the dropdown list to the vertical cells but have it back to a working state again (horizontal only). Is it possible to combine the 2 codes and add cell borders to accomplish this or am I limited based upon what I am trying to accomplish? I have included a screenshot in hopes to clarify.

 

[kevin9999]

Try the following

Private Sub Worksheet_Change(ByVal Target As Range)
    Application.EnableEvents = False
    If Not Intersect(Range("B1"), Target) Is Nothing Then
        Range("C1:Q1").Clear
        Dim horz As Long
        horz = Range("B1").Value
        If horz > 0 Then
            With Range("C1")
                .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                Formula1:="=Options"
                .Interior.Color = vbYellow
                .BorderAround ColorIndex:=1, Weight:=xlThin
                .Copy
                .Resize(, horz).PasteSpecial xlPasteValidation
                .Resize(, horz).PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
                .Select
            End With
        End If
    End If
    
    If Not Intersect(Range("B2"), Target) Is Nothing Then
        Range("C2:C16").Clear
        Dim vert As Long
        vert = Range("B2").Value
        If vert > 0 Then
            With Range("C2")
                .Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                Formula1:="=Options"
                .Interior.Color = vbYellow
                .BorderAround ColorIndex:=1, Weight:=xlThin
                .Copy
                .Resize(vert).PasteSpecial xlPasteValidation
                .Resize(vert).PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
                .Select
            End With
        End If
    End If
    Application.EnableEvents = True
End Sub