Forum Discussion
Autopopulate a drop down from another drop down
See the attached version. It uses a combination of Data Validation and VBA (in the worksheet module).
HansVogelaar This is exactly what I wanted! Thank you so much.
How do go about setting it up on a different workbook?
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.
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
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 SubThank 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 IfEnd Sub