SOLVED

Autopopulate a drop down from another drop down

New Contributor

How do I set up to autofill several cells (containing drop downs) depending on the value of another drop down?

 

For example,

If x is selected from the dropdown in column A, then I want Columns B-F to say 'N/A', but if Y is selected, I want columns B-F as drop downs

 

Thank you

8 Replies

@M2021L 

You may google for "excel dependant drop-down list", lot of materials with samples. First I received Creating a Dependent Drop Down List in Excel [Step-by-Step Tutorial] (trumpexcel.com)

best response confirmed by M2021L (New Contributor)
Solution

@M2021L 

See the attached version. It uses a combination of Data Validation and VBA (in the worksheet module).

@Hans Vogelaar This is exactly what I wanted! Thank you so much. 

 

How do go about setting it up on a different workbook?

@M2021L 

You'll need to copy the code from the worksheet module *) to the worksheet module of the sheet you want to apply it to, and modify the code according to the exact setup you have.

 

*) Right-click the sheet tab and select View Code from the context menu to activate the Visual Basic Editor and view the worksheet module.

 

I used named ranges for the data validation rules. See Formulas > Name Manager.

@Hans Vogelaar 

 

Thank you for your reply.

 

For the following line of code, I understand that I need to change 'Result' as this is showing up as an error but what do I change it to as I have several possible drop downs that will apply to different columns.

.Add Type:=xlValidateList, Formula1:="=Result"

 

Similar to the your example, I have several columns that need autopopulating (i.e. Result 1, Result 2, Result 3 etc) however, each have a different drop down menu. 

 

Thanks

@M2021L 

Assign a name to each source list. The names must be single words, without spaces or punctuation; underscores _ are allowed. So for example Result1, Result2, etc.

You can then use code like this:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rng As Range
    If Not Intersect(Range("A2:A9"), Target) Is Nothing Then
        Application.ScreenUpdating = False
        Application.EnableEvents = False
        Set rng = Intersect(Range("A2:A9"), Target).Offset(, 1).Resize(, 5)
        rng.Validation.Delete
        Select Case Intersect(Range("A2:A9"), Target).Cells(1).Value
            Case "X"
                rng.Value = "N/A"
            Case "Y"
                rng.ClearContents
                With rng.Columns(1).Validation
                    .Add Type:=xlValidateList, Formula1:="=Result1"
                    .ErrorMessage = "Please select an item from the list!"
                End With
                With rng.Columns(2).Validation
                    .Add Type:=xlValidateList, Formula1:="=Result2"
                    .ErrorMessage = "Please select an item from the list!"
                End With
                ' etc.
            Case Else
                ' Do nothing?
        End Select
        Application.EnableEvents = True
        Application.ScreenUpdating = True
    End If
End Sub

@Hans Vogelaar 

 

Thank you!! I understand what you have done, how would I add another range to the code? Would the below work (start of next range highlighted in red)?

 

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
If Not Intersect(Range("BH2:BH20"), Target) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
Set rng = Intersect(Range("BH2:BH20"), Target).Offset(, 1).Resize(, 5)
rng.Validation.Delete
Select Case Intersect(Range("BH2:BH20"), Target).Cells(1).Value
Case "No"
rng.Value = "N/A"
Case "Yes"
rng.ClearContents
With rng.Columns(1).Validation
.Add Type:=xlValidateList, Formula1:="=Details"
.ErrorMessage = "Please select an item from the list!"
End With
With rng.Columns(2).Validation
.Add Type:=xlValidateList, Formula1:="=RFP"
.ErrorMessage = "Please select an item from the list!"
End With
With rng.Columns(3).Validation
.Add Type:=xlValidateList, Formula1:="=HIA"
.ErrorMessage = "Please select an item from the list!"
End With
With rng.Columns(4).Validation
.Add Type:=xlValidateList, Formula1:="=Location"
.ErrorMessage = "Please select an item from the list!"
End With
Case Else
' Do nothing?
End Select
Application.EnableEvents = True
Application.ScreenUpdating = True

End If


If Not Intersect(Range("AC2:AC20"), Target) Is Nothing Then
Application.ScreenUpdating = False
Application.EnableEvents = False
Set rng = Intersect(Range("AC2:AC20"), Target).Offset(, 1).Resize(, 5)
rng.Validation.Delete
Select Case Intersect(Range("AC2:AC20"), Target).Cells(1).Value
Case "Contact"
rng.Value = "N/A"
Case "Yes"
rng.ClearContents
With rng.Columns(1).Validation
.Add Type:=xlValidateList, Formula1:="=Header_tactical_focus"
.ErrorMessage = "Please select an item from the list!"
End With
With rng.Columns(2).Validation
.Add Type:=xlValidateList, Formula1:="=Neck_twist"
.ErrorMessage = "Please select an item from the list!"
End With
With rng.Columns(3).Validation
.Add Type:=xlValidateList, Formula1:="=Header_anticipation"
.ErrorMessage = "Please select an item from the list!"
End With
With rng.Columns(4).Validation
.Add Type:=xlValidateList, Formula1:="=Header_situations"
.ErrorMessage = "Please select an item from the list!"
End With
Case Else
' Do nothing?
End Select
Application.EnableEvents = True
Application.ScreenUpdating = True
End If

End Sub

@M2021L 

Yes, that looks correct at a quick glance.