[Solved] Disable list option on drop down in data validation base on other cells value

[bigme]

dear all,
kindly help me to do my task, i have a table if i entry a value in column A then in column B make a drop down using data validation it will show only value that related to column A value, herewith i attach the sample file, thank you.

regard,
bigMe

 

[Lutfor Rahman Shimanto]

dear all,
kindly help me to do my task, i have a table if i entry a value in column A then in column B make a drop down using data validation it will show only value that related to column A value, herewith i attach the sample file, thank you.

regard,
bigMe

Hello BigMe

Thanks for posting your comment with such clarity.
Based on the cell values of column A, you want to create or clear a drop-down list in the corresponding cells of column B.

I am delighted to inform you that I have developed such an idea that will fulfil your requirements. To do so, I have used Excel formulas implemented by combining IF, FILTER and TEXTJOIN functions. I had to develop an event procedure as well as a sub-procedure.

Follow these steps:

Step 1: Select cell O2 => Insert the following formula => Drag the Fill Handle icon to O8.
Excel Formula:

=TEXTJOIN(", ",TRUE,IF(A2="","",IF(A2="meat",FILTER($J$2:$J$6,$I$2:$I$6="meat"),IF(A2="Fruits",FILTER($J$2:$J$6,$I$2:$I$6="Fruits"),FILTER($J$2:$J$6,$I$2:$I$6="vegetable")))))

​

Select the entire column O => Right-click on the column name => Click on Hide.

​

Step 2: Right-click on the sheet name tab => Click on View Code.

​

Step 3: Paste the following code in the sheet module => Click on the Save icon.
Excel VBA Sub-Procedure:

Sub CreateDropDownList()
   
    Dim LastRowA As Long, LastRowO As Long
    Dim WS As Worksheet
    Dim cell As Range
    Dim DropdownRange As Range
   
    Set WS = ThisWorkbook.Sheets("Sheet1")
   
    LastRowA = WS.Cells(WS.Rows.Count, "A").End(xlUp).Row
    LastRowO = WS.Cells(WS.Rows.Count, "O").End(xlUp).Row
   
    For Each cell In WS.Range("A2:A" & LastRowA)
        If Not IsEmpty(cell.Value) Then
            Dim ValueInO As String
            ValueInO = ""
            On Error Resume Next
            ValueInO = WS.Cells(cell.Row, "O").Value
            On Error GoTo 0
           
            If ValueInO <> "" Then
                Set DropdownRange = WS.Cells(cell.Row, "B")
                With DropdownRange.Validation
                    .Delete
                    .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
                    xlBetween, Formula1:=ValueInO
                    .IgnoreBlank = True
                    .InCellDropdown = True
                    .ShowInput = True
                    .ShowError = True
                End With
            End If
        End If
    Next cell

End Sub

Excel VBA Event Procedure:

Private Sub Worksheet_Change(ByVal Target As Range)
   
    Dim rng As Range
    Dim cell As Range
    Dim lastRow As Long

    If Not Intersect(Target, Me.Range("A:A")) Is Nothing Then
        Application.EnableEvents = False

        For Each cell In Target
            If cell.Column = 1 And cell.Row >= 2 Then
                If cell.Value = "" Then
                    Me.Cells(cell.Row, "B").ClearContents
                    Me.Cells(cell.Row, "B").Validation.Delete
                Else
                    Call CreateDropDownList
                End If
            End If
        Next cell

        Application.EnableEvents = True
    End If

End Sub

​

OUTPUT:

​

I have also attached the solution workbook to help you understand better. Good luck!

Regards
Lutfor Rahman Shimanto