Change multiple cells based on dropdown list value.

Does someone has an idea how to fix this?
Or is my explanation not clear enough?

No one has any ideas?

Hi NKuip
Please, attach a sample workbook. Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are shown, mock them up manually if necessary.

Remember to desensitize the data.

Click on GO ADVANCED and then scroll down to 'Manage Attachments' to open the upload window.

Maybe?

Sub NKuip()
Dim x As Range, y As Long
Range("B3:B" & Range("B" & Rows.count).End(3).row).ClearContents
Set x = Sheets("Database").Columns(1).Find(Range("A2"), LookIn:=xlValues, lookat:=xlWhole)
    If Not x Is Nothing Then
        y = Sheets("Database").Cells(x.row, 1).End(xlDown).row - 1
        With Sheets("Database")
            .Range(.Cells(x.row, 2), .Cells(y, 2)).Copy Range("B3")
        End With
    End If
Set x = Nothing
End Sub

or maybe so

Private Sub Worksheet_Activate()
Dim x, i&, s$

x = Sheets("Database").Range("A1").CurrentRegion.Value
With CreateObject("Scripting.Dictionary")
    .CompareMode = 1
    For i = 2 To UBound(x, 1)
        .Item(x(i, 1)) = Empty
    Next i
    s = Join(.keys, ",")
End With

With Range("A2:A20").Validation
    .Delete
    .Add Type:=xlValidateList, Formula1:=s
End With
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Len(Target) = 0 Then Exit Sub
If Intersect(Target, Range("A2:A20")) Is Nothing Then Exit Sub

Dim x, i&, st$, s$
st = Target.Value
x = Sheets("Database").Range("A1").CurrentRegion.Value

For i = 2 To UBound(x)
    If x(i, 1) = st Then s = s & "," & x(i, 2)
Next i
If Len(s) = 0 Then Exit Sub

With Target(1, 2).Validation
    .Delete
    .Add Type:=xlValidateList, Formula1:=s
End With
End Sub

@nilem

I get your principle, with the second list. But all sub-processes have to be displayed anyway.