lyk
lyk

Reputation: 1598

Updating a dynamic dropdown list in excel upon change in cell value

I am trying to create a form which hopefully updates the list of values for a particular dropdown list automatically (without VBA codes) upon user's input immediately.

Here is the form that the user will see:

enter image description here

Currently, both Columns F and H is based on a data-validation formula:

INDIRECT("VList!"&SUBSTITUTE(ADDRESS(1,MATCH($B11,VList!$1:$1,0),1),"1","")&"2:"&SUBSTITUTE(ADDRESS(1,MATCH($B11,VList!$1:$1,0),1),"1","")&COUNTA(INDIRECT("VList!"&ADDRESS(1,MATCH($B11,VList!$1:$1,0),4)&":"&ADDRESS(100,MATCH($B11,VList!$1:$1),4))))

... where VList refers to the sheet as shown below:

enter image description here

So my question here is, based on the Project Name in Column B, is there a way to update the list in sheet VList with the value "Cost Per Unit" [Cell E11], so that the dropdown list in F12 and H12 get automatically updated with the value "Cost Per Unit"?

Been researching a long time for this with no avail, so I'm hoping to seek some experts here to see if such a scenario is even possible without VBA. Thanks!

Edit: So I've been told that VBA codes can be triggered automatically upon changes in the cell value, so I am open to any solutions/help with VBA as well. Will be researching on that direction in the meantime!

Edit2: Added a simple illustration below that hopefully better depicts what I'm trying to achieve on excel: enter image description here

*Edit3: I'm starting to explore the Worksheet_SelectionChange method, and this is what I've come out so far:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim projectName As String
    Dim VariableList As Worksheet
    Dim Form As Worksheet

    Dim thisRow As Integer
    Dim correctColumn As Integer
    Dim lastRow As Integer

    Set VariableList = ThisWorkbook.Sheets("VList")
    Set Form = ThisWorkbook.Sheets("Form")

    On Error GoTo EndingSub

    If Target.Column = 5 Then
        thisRow = Target.Row
        projectName = Form.Cells(thisRow, 2)

        correctColumn = Application.Match(projectName, VariableList.Range("1:1"), 0)

        lastRow = VariableList.Columns(correctColumn).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

        VariableList.Cells(lastRow + 1, correctColumn).value = Form.Cells(5, thisRow).value

    End If

EndingSub:

End Sub

Somehow the value of Form.Cells(5, thisRow).Value is always empty.

If I change it to Target.Value it still takes the previous value that was being input (e.g. I first put "ABC" as New Variable, it doesn't get updated. I changed New Variable to "DEF", it updates the list with "ABC" instead of "DEF"). It also takes ALL the values that are under Column E somehow.

Also, pressing Enter after I placed one input in E11 also causes both values of E11 and E12 to be updated when only E12 has been changed. However if I click away after E11 is being input, then only E11's value gets updated.

What exactly am I doing wrong here?

Upvotes: 0

Views: 10050

Answers (1)

user3819867
user3819867

Reputation: 1118

I was almost having fun with this one, if anyone can refine the screwed-up parts feel free to amend.
I furthermore recommend using tables. I do realise you can write lengthy formulae to refer to ranges but giving a name to your table gives an expanding list with a simple reference.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim NewVar As Range
On Error GoTo Err
Set NewVar = Range("C:C") 'data entered here, could be a referstorange kind of named range reference
If Application.WorksheetFunction.CountA(Intersect(Target, NewVar)) <> 0 Then Call ertdfgcvb(Target, NewVar) 'only run if there's an intersect, f*ed up but works anyway
Err:
End Sub

Sub ertdfgcvb(Target As Range, NewVar As Range)
Dim ws As Worksheet, Valid As Long, project As String, ListElmnt As String, Unlisted As Boolean, rng1 As Range, rng2 As Range

Set ws = Sheets("VList") 'the data that you refresh
Valid = 2 'projects in column B
HeaderRow = 1 'headers in Vlist are in row #1
uRow = Cells.Rows.Count 'f* yeah, compatibility considerations

For Each Cell In Intersect(Target, NewVar) 'will evaluate for each cell individually, in case you were to insert columns
    ListElmnt = Cell.Value2            'stores the prospective list element
    r = Cell.Row                       'stores the list element's row to...
    project = Cells(r, Valid).Value2   'identify the related project

    HeaderRowRef = HeaderRow & ":" & HeaderRow
    ColumnNum = ws.Range(HeaderRowRef).Find(What:=project, SearchDirection:=xlPrevious, SearchOrder:=xlByColumns, LookAt:=xlWhole).Column   'finds the project in VList
    'MsgBox ws.Name
    Set rng1 = ws.Cells(HeaderRow + 1, ColumnNum)
    Set rng2 = ws.Cells(uRow, ColumnNum)
    LastRow = ws.Range(ws.Cells(HeaderRow + 1, ColumnNum), ws.Cells(uRow, ColumnNum)).Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 'finds the last row for the project in VList 'f*ed up but works
    Unlisted = True                                                                  'assumes it's unlisted
        For x = HeaderRow + 1 To LastRow
            If ListElmnt = CStr(ws.Cells(x, ColumnNum).Value2) Then Unlisted = False 'unless proven otherwise
        Next
    If Unlisted Then ws.Cells(LastRow + 1, ColumnNum) = ListElmnt                    'if it's unlisted it gets appended to the end of the list
Next
End Sub

EDIT:
How to purge the table, example:

Sub ert()
Dim rng As Range

Set rng = Range("Táblázat1")         'obviously the table name
Do While x < rng.Rows.Count          'for each row
    If rng(x, 1).Value2 = "" Then    'if it's empty
        rng(x, 1).Delete Shift:=xlUp 'then delete but retaining the table format
    Else
        x = x + 1                    'else go to the next line (note: with deletion comes a shift up!)
    End If
Loop

End Sub

Upvotes: 1

Related Questions