Dynamic Depending Lists in Separated WorkSheets in VBA (2)

Question

I'm working with 7 dynamic dependent lists, and I thought the best way to automate the process and avoid to arrange anything in a future if I modify the lists was a VBA code.

The VBA code that I started to work on it is posted on: Dynamic Depending Lists in Separated WorkSheets in VBA

That code is just for the 2 first lists.

That's the main table that I have. I want pick lists for the first row only for the yellow columns:

That's the table that I have the lists (they must be dynamic):

The relations between my lists are:

• Responsible list and Site list are related with Project list.
• The other lists are related with the site list.

Answer 1

Okay. I've got what you are looking for. I solved this issue a few months back in another project. Basically, indirect is no good here because it doesn't work on dynamic named ranges, because they don't produce an actual result, just a formula reference.

First, set up your named ranges on a sheet like so. It's very important that the named ranges be named in the manner I described, as this will feed the code into making your dynamic lists. Also, note, I only wrote out SamplePoints for X1 and T2. If you select other options, the code won't work until you add those named ranges in.

Then assuming input sheet is set up like below:

Place this code in the worksheet change event of your input sheet. What it does is take the value selected in one cell and then appends the appropriate column name to feed that list. So, if Project A is selected and you want to pick a responsible party for project A, it sets the validation in Range("B(whatever row you are on)" to be A_Responsible, thus giving you that list.

Private Sub Worksheet_Change(ByVal Target As Range)

Dim wks As Worksheet
Dim strName As String, strFormula
Dim rng As Range

Set wks = ActiveSheet

With wks

    If Target.Row = 1 Then Exit Sub

    Select Case Target.Column

        Case Is = .Rows(1).Find("Project", lookat:=xlWhole).Column

            Set rng = Target.Offset(, 1)

            strName = Target.Value
            strFormula = "=" & Replace(strName, " ", "_") & "_Responsible"

            AddValidation rng, 1, strFormula

            'add any more cells that would need validation based on project selection here.

        Case Is = .Rows(1).Find("Responsible", lookat:=xlWhole).Column

            Set rng = Target.Offset(, 1)

            strName = Target.Value
            strFormula = "=" & Replace(strName, " ", "_") & "_SamplePoint"

            AddValidation rng, 1, strFormula

            'add any more cells that would need validation based on responsible selection here.

        'Case Is = add any more dependenices here ... and continue with cases for each one

    End Select

End With

You will also need this function in a standard module somewhere in your workbook.

Function AddValidation(ByVal rng As Range, ByVal iOperator As Integer, _
    ByVal sFormula1 As String, Optional iXlDVType As Integer = 3, _
    Optional iAlertStyle As Integer = 1, Optional sFormula2 As String, _
    Optional bIgnoreBlank As Boolean = True, Optional bInCellDropDown As Boolean = True, _
    Optional sInputTitle As String, Optional sErrorTitle As String, _
    Optional sInputMessage As String, Optional sErrorMessage As String, _
    Optional bShowInput As Boolean = True, Optional bShowError As Boolean = True)

'==============================================
'Enumaration for ease of use
'XlDVType
'Name Value Description
'xlValidateCustom 7 Data is validated using an arbitrary formula.
'xlValidateDate 4 Date values.
'xlValidateDecimal 2 Numeric values.
'xlValidateInputOnly 0 Validate only when user changes the value.
'xlValidateList 3 Value must be present in a specified list.
'xlValidateTextLength 6 Length of text.
'xlValidateTime 5 Time values.
'xlValidateWholeNumber 1 Whole numeric values.

'AlertStyle
'xlValidAlertInformation 3 Information icon.
'xlValidAlertStop 1 Stop icon.
'xlValidAlertWarning 2 Warning icon.

'Operator
'xlBetween 1 Between. Can be used only if two formulas are provided.
'xlEqual 3 Equal.
'xlGreater 5 Greater than.
'xlGreaterEqual 7 Greater than or equal to.
'xlLess 6 Less than.
'xlLessEqual 8 Less than or equal to.
'xlNotBetween 2 Not between. Can be used only if two formulas are provided.
'xlNotEqual 4 Not equal.
'==============================================

With rng.Validation
    .Delete ' delete any existing validation before adding new one
    .Add Type:=iXlDVType, AlertStyle:=iAlertStyle, Operator:=iOperator, Formula1:=sFormula1, Formula2:=sFormula2
    .IgnoreBlank = bIgnoreBlank
    .InCellDropdown = bInCellDropDown
    .InputTitle = sInputTitle
    .ErrorTitle = sErrorTitle
    .InputMessage = sInputMessage
    .ErrorMessage = sErrorMessage
    .ShowInput = bShowInput
    .ShowError = bShowError
End With


End Function