Passing Range Variable into formula regarding multiple dependency in Macro Excel

Question

This following is the code for my excel

While to create multiple dependency via macros, i am getting error on

.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=indirect("A" & i)"

Still trying to figure out how to pass range value into the formula section

Sub listing()

Dim cellv As Range

For i = 3 To 10000

Set cella = Sheet1.Range("A" & i)
    With cella.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=Main"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = "Invalid Input"
        .InputMessage = ""
        .ErrorMessage = "Select the location only from the dropdown list."
        .ShowInput = False
        .ShowError = True
    End With

Set cellb = Sheet1.Range("B" & i)
    With cellb.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:="=indirect("A" & i)"
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = "Invalid Input"
        .InputMessage = ""
        .ErrorMessage = "Select the location only from the dropdown list."
        .ShowInput = False
        .ShowError = True
    End With

Next

End Sub

Answer 1

If my understanding is correct you have the following:

1. A Defined Name called Main that holds a list of Defined Names or Ranges

This is what you want to achieve:

1. A Data Validation in column A pointing to the Defined Name Main so the users will select from the Defined Names it contains.
2. A Data Validation in column B pointing to the Defined Name selected in the adjacent cell in column A

Now in your answers to comments you mention 1000 cells , but your code has For i = 3 To 10000

Nevertheless few questions come to mind:

Is this workbook expected to work with 1000 Defined Names at once?

Do your users will select 1000 items from other 1000 Defined Names manually?

What the use of this list will be?

Also bear in mind that (as @JoeMalpass reminded me today)

the use of INDIRECT is great for small data sets, it can make things a bit sluggish on larger sheets because it is a volatile function and requires recalculation any time anything changes in the workbook (even changes made to cells that have no impact on the those using or referenced by the indirect function).

And in your case you plan to use the INDIRECT functions in at least 1000 cells. I'm not trying to challenge your solution, but would like to think that since you are using VBA there should be other more practical methods to satisfy your needs. In this respect I will provide you with VBA solution in a separated answer .

Based on the above let's continue with your code. There are two errors with your code:

1. In the “Formula1” of the Data Validation for column B the concatenation for the INDIRECT formula needs to be a data type Variant, as such change it to:

   Formula1:="=INDIRECT(" & CVar("A" & i) & ")"

2. The second error is the same error triggered when trying to create this Data Validation manually:

The Source currently evaluates to an error.

Fig. 1

This basically means that the Data Validation is pointing to an inexistent Defined Name called “” (blank) . When doing it manually you have the option to continue and the Data Validation is created and eventually fits the desired purpose, once the “Source” cell is updated by the user with a valid Defined Name. However, this error in VB does not allow the creation of the Data Validation.

This can be fixed with a temporary assignment of a known name to each Source cell in column A (ie Main ) and clearing it after the Data validation in Column B is created.

Below is the revised code Also added the procedure Process_IniEnd to have the code running faster

Option Explicit

Sub DataValidation_Indirect()
Const kRow As Integer = 1000
Dim CllA As Range, CllB As Range
Dim i As Integer

    Process_IniEnd 1

    Rem Clear Target Cells in Columns A & B
    ThisWorkbook.Sheets(1).Range(Cells(3, 1), Cells(kRow, 2)).Clear  'Replace [ThisWorkbook.Sheets(1)] as required

    For i = 3 To kRow

        Rem Set Cell A in Columns A
        Set CllA = ThisWorkbook.Sheets(1).Range("A" & i)    'Replace [ThisWorkbook.Sheets(1)] as required

        Rem Set Validation in Cell A
        With CllA.Validation
            .Delete
            .Add Type:=xlValidateList, _
                AlertStyle:=xlValidAlertStop, _
                Operator:=xlBetween, _
                Formula1:="=Main"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = "Invalid Input"
            .InputMessage = ""
            .ErrorMessage = "Select the location only from the dropdown list."
            .ShowInput = False
            .ShowError = True
        End With

        Rem Enter Temporary Name in Cell A
        CllA.Value = "Main"

        Rem Set Cell B in Columns B
        Set CllB = ThisWorkbook.Sheets(1).Range("B" & i)    'Replace [ThisWorkbook.Sheets(1)] as required

        Rem Set Validation in Cell B
        With CllB.Validation
            .Delete
            .Add Type:=xlValidateList, _
                AlertStyle:=xlValidAlertStop, _
                Operator:=xlBetween, _
                Formula1:="=INDIRECT(" & CVar("A" & i) & ")"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = "Invalid Input"
            .InputMessage = ""
            .ErrorMessage = "Select the location only from the dropdown list."
            .ShowInput = False
            .ShowError = True
        End With

        Rem Clear Temporary Name in Cell A
        CllA.ClearContents

    Next

    Process_IniEnd 0

End Sub


Sub Process_IniEnd(blIni As Boolean)
    Select Case blIni
    Case True
        With Application
            .Calculation = xlManual
            .EnableEvents = False
            .DisplayAlerts = False
            .ScreenUpdating = False
        End With

    Case False
        With Application
            .EnableEvents = True
            .DisplayAlerts = True
            .ScreenUpdating = True
            .Calculation = xlAutomatic
        End With
    End Select
End Sub

Answer 2

If my understanding is correct you have the following:

1. A defined name called Main that holds a list of Defined Names or Ranges

This is what you want to achieve:

1. Data Validations in column A pointing to the Defined Name “ Main ” so the users will select from the Defined Names it contains
2. Data Validations in column B pointing to the Defined Name selected in the adjacent cell in column A

Based on the above I propose to use the Worksheet_Change event to create the Data Validations in column B when the user select the Defined Name in column A

This solution requires:

1. Procedure to create Data Validations in column A
2. Procedure to create Data Validations in columns B from the validation of the range with changes passed by the Worksheet_Change event

Paste the following code in the VB code of the worksheet. (To activate the VB Code of the Worksheet right-click the tab of the worksheet then select “View Code” see Fig. 1)

Fig. 1

Option Explicit

Private Sub Worksheet_Change(ByVal RngSrc As Range)
    WshEvn_DataValidation RngSrc
End Sub

Then paste the following code in a VB Module in the same workbook

Option Explicit

Const kRow As Integer = 1000


Sub DataValidation_Main()
Dim CllA As Range
Dim i As Integer

    Debug.Print "Ini: "; Now
    Process_IniEnd 1

    Rem Clear Target Cells in Columns A & B
    ThisWorkbook.Sheets(1).Range(Cells(3, 1), Cells(kRow, 2)).Clear  'Replace [ThisWorkbook.Sheets(1)] as required

    For i = 3 To kRow
        Rem Set Cell A in Columns A
        Set CllA = ThisWorkbook.Sheets(1).Range("A" & i)    'Replace [ThisWorkbook.Sheets(1)] as required

        Rem Set Validation in Cell A
        With CllA.Validation
            .Delete
            .Add Type:=xlValidateList, _
                AlertStyle:=xlValidAlertStop, _
                Operator:=xlBetween, _
                Formula1:="=Main"
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = "Invalid Input"
            .InputMessage = ""
            .ErrorMessage = "Select the location only from the dropdown list."
            .ShowInput = False
            .ShowError = True
        End With

    Next

    Process_IniEnd 0
    Debug.Print "End: "; Now

End Sub


Sub WshEvn_DataValidation(ByVal RngSrc As Range)
Dim RngTrg As Range
Dim rCll As Range

    Debug.Print "Ini: "; Now
    Process_IniEnd 1

        Rem Validate Source Range & Set Target Range
        Set RngTrg = Application.Intersect(RngSrc, RngSrc.Worksheet.Range(Cells(3, 1), Cells(kRow, 1)))
        If Not (RngTrg Is Nothing) Then
            For Each rCll In RngTrg.Cells

                Rem Set Validation in Column B
                With rCll.Offset(0, 1).Validation
                    .Delete
                    On Error Resume Next
                    .Add Type:=xlValidateList, _
                        AlertStyle:=xlValidAlertStop, _
                        Operator:=xlBetween, _
                        Formula1:="=" & rCll.Value2
                    If Err.Number <> 0 Then GoTo NEXT_Cll
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .InputTitle = ""
                    .ErrorTitle = "Invalid Input"
                    .InputMessage = ""
                    .ErrorMessage = "Select the location only from the dropdown list."
                    .ShowInput = False
                    .ShowError = True
                End With
NEXT_Cll:
    Next: End If

    Process_IniEnd 0
    Debug.Print "End: "; Now

End Sub

Sub Process_IniEnd(blIni As Boolean)
    Select Case blIni
    Case True
        With Application
            .Calculation = xlManual
            .EnableEvents = False
            .DisplayAlerts = False
            .ScreenUpdating = False
        End With

    Case False
        With Application
            .EnableEvents = True
            .DisplayAlerts = True
            .ScreenUpdating = True
            .Calculation = xlAutomatic
        End With
    End Select
End Sub