'-------------------Start of Code---------------------
Private Sub Worksheet_Change(ByVal Target As Range)
'
' The following code was created/modified on 10/21/2006 by Stanley D. Grom, Jr.
' The original code was posted to Mr. Excel
' by rajibdas, Aug 31, 2006 9:19 am Post subject:
If Intersect(Target, Range("B1")) Is Nothing Then 'cell where you'll have the inital dropdown list
If Intersect(Target, Range("C1")) Is Nothing Then
Exit Sub
ElseIf Range("C1").Value = "" Then
Range("D1").Select
Range("D1").ClearContents
With Selection.Validation
.Delete
End With
Range("C1").Select
Exit Sub
ElseIf Range("C1").Value = "A - PRELIMINARIES" Then
Range("D1").Select
Range("D1").ClearContents
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$J$2:$J$9"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Exit Sub
ElseIf Range("C1").Value = "B - GROUND INVESTIGATION" Then
Range("D1").Select
Range("D1").ClearContents
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$K$2:$K$12"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Exit Sub
ElseIf Range("C1").Value = "C - GEOTECHNICAL AND OTHER SERVICES" Then
Range("D1").Select
Range("D1").ClearContents
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$L$2:$L$4"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Exit Sub
ElseIf Range("C1").Value = "D - DEMOLITION AND SITE CLEARANCE" Then
Range("D1").Select
Range("D1").ClearContents
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$M$2:$M$4"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Exit Sub
ElseIf Range("C1").Value = "E - EARTHWORKS" Then
Range("D1").Select
Range("D1").ClearContents
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$N$2:$N$9"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Exit Sub
' Setup code for the following selections (see above example)
'F - IN SITU CONCRETE
'G - CONCRETE ANCILLIARIES
'M - STRUCTURAL METALWORK
'N - MISCELLANEOUS METALWORK
'R - ROADS AND PAVINGS
'X - MISCELLANEOUS WORK
'Y - SEWER AND WATER MAIN RENOVATION AND ANCILLIARY WORKS
'Z - CLASS Z: BUILDING WORKS
'Miscellaneous
End If
Exit Sub
ElseIf Range("B1").Value = "" Then ' if cell B1 blank, blank C1
Range("C1").Select
Range("C1").ClearContents
With Selection.Validation ' create the second dropdown on cells C1
.Delete
End With
Range("B1").Select
Exit Sub
ElseIf Range("B1").Value = "Structures" Then ' if cell B1 is the name you select
Range("C1").Select
Range("C1").ClearContents
With Selection.Validation ' create the second dropdown on cells C1
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$G$2:$G$17"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Exit Sub
ElseIf Range("B1").Value = "Pipework" Then
Range("C1").Select
Range("C1").ClearContents
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$H$2:$H$11"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Exit Sub
ElseIf Range("B1").Value = "MEICA" Then
Range("C1").Select
Range("C1").ClearContents
With Selection.Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$I$2:$I$4"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
Exit Sub
End If
End Sub
'-------------------End of Code---------------------