Reputation: 1598
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:
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:
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:
*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
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