Autopopulate cells with value from In-cell dropdown list - VBA

Question

Goal

I would like to loop through three sheets (I'm starting with one), look for a certain Type in column C and automatically populate/autopopulate a In-cell dropdown (similar to the one found in the Data Validation settings) in column D. The In-cell dropdown should list values for all Types but should autopopulate with the value belong to the Type.

Problem

The code below populates every In-cell dropdown list with the same value, namely Type1's Item1--Item2--Item3--Item4.

I don't know how to list all values and at the same time autopopulate the cell.

Desired output

Code

For the sake of simplicity, I have only added the two first types in the code below.

Sub AutoDropdown()

Dim PersonSource As Range
Dim PersonSourceTotal As Range
Dim PersonCell As Range
'Dim ws As Worksheet

Dim i As Integer
Dim lastRow As Integer

Set PersonSourceTotal = Sheets("Sheet1").Range("D2:D200")

With PersonSourceTotal.Offset(0, -2)
    lastRow = .Cells(.Rows.Count, PersonSourceTotal.Columns.Count).End(xlUp).Row
End With

Set PersonSource = Sheets("sheet1").Range("D2:D" & lastRow)

On Error Resume Next

For Each PersonCell In PersonSource
    Name = PersonCell.Offset(0, -3)
    ID = PersonCell.Offset(0, -2)
        If Name <> "" And ID <> "" Then
            For i = 0 To lastRow
                If PersonCell.Offset(i, -1) = "Type1" Then
                    arr1 = Array("Item1", "Item2", "Item3", "Item4")
                    arr1Merged = Join(arr1, "--")
                    With PersonCell.Validation
                                                .Delete
                                                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                                                Operator:=xlBetween, Formula1:=arr1Merged
                                                .IgnoreBlank = True
                                                .InCellDropdown = True
                                                .InputTitle = ""
                                                .ErrorTitle = ""
                                                .InputMessage = ""
                                                .ErrorMessage = ""
                                                .ShowInput = True
                                                .ShowError = True
                    End With
                ElseIf PersonCell.Offset(i, -1) = "Type2" Then
                    arr2 = Array("Item5", "Item6", "Item7", "Item8", "Item9")
                    arr2Merged = Join(arr2, "--")
                    Debug.Print (arr2Merged)
                    With PersonCell.Validation
                                                .Delete
                                                .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, _
                                                Operator:=xlBetween, Formula1:=arr2Merged
                                                .IgnoreBlank = True
                                                .InCellDropdown = True
                                                .InputTitle = ""
                                                .ErrorTitle = ""
                                                .InputMessage = ""
                                                .ErrorMessage = ""
                                                .ShowInput = True
                                                .ShowError = True
                    End With
                End If
            Next i
        Else
            MsgBox "Remember to add Name and ID"
        End If
Next PersonCell
End Sub

Xabier Xabier · Accepted Answer · 2017-12-15T15:03:10

EDIT:

After your comments I've updated the code to try to better reflect your requirements:

Sub AutoDropdown()
Dim PersonSource As Range
Dim PersonSourceTotal As Range
Dim PersonCell As Range
Dim i As Long
Dim lastRow As Long
Dim SelectionArray(1 To 4) As String

Set PersonSourceTotal = Sheets("Sheet1").Range("D2:D200")

With PersonSourceTotal.Offset(0, -2)
    lastRow = .Cells(.Rows.Count, PersonSourceTotal.Columns.Count).End(xlUp).Row
End With

Set PersonSource = Sheets("Sheet1").Range("D2:D" & lastRow)

arr1 = Array("Item1", "Item2", "Item3", "Item4") 'Define your selections items
arr2 = Array("Item5", "Item6", "Item7", "Item8", "Item9")
arr3 = Array("ItemE", "ItemF", "ItemG", "ItemH")
arr4 = Array("ItemA", "ItemB", "ItemC", "ItemD")

SelectionArray(1) = Join(arr1, "--") 'join the selections into another array
SelectionArray(2) = Join(arr2, "--")
SelectionArray(3) = Join(arr3, "--")
SelectionArray(4) = Join(arr4, "--")
AllSelections = Join(SelectionArray, ",") 'group all selections for data validation
On Error Resume Next

For Each PersonCell In PersonSource
    VarName = PersonCell.Offset(0, -3)
    ID = PersonCell.Offset(0, -2)
        If VarName <> "" And ID <> "" Then
            Select Case PersonCell.Offset(i, -1).Value
                Case "Type1"
                    With PersonCell.Validation
                        .Delete
                        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=AllSelections
                    End With
                    PersonCell.Value = SelectionArray(1)
                Case "Type2"
                    With PersonCell.Validation
                        .Delete
                        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=AllSelections
                    End With
                    PersonCell.Value = SelectionArray(2)
                Case "Type3"
                    With PersonCell.Validation
                        .Delete
                        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=AllSelections
                    End With
                    PersonCell.Value = SelectionArray(3)
                Case "Type4"
                With PersonCell.Validation
                        .Delete
                        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=AllSelections
                    End With
                    PersonCell.Value = SelectionArray(4)
                Case Else
                    MsgBox "No Type was entered on Column C"
            End Select
        Else
            MsgBox "Remember to add VarName and ID"
        End If
Next PersonCell
End Sub

UPDATE:

To get the above code to run automatically when a the value of Column C (ie. Type Number) is changed then you should add the following code under Sheet1:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 3 Then AutoDropdown 'if a value is changed on Column 3/ Column C then call the name of the above subroutine, in this case it is called AutoDropdown
End Sub

Autopopulate cells with value from In-cell dropdown list - VBA

1 Answers