Vlookup in VBA: Creating dynamic List and lookup Multiple Values

[TrueRad]

Hi everyone,
I would like to ask for a help with my project. I'm trying to create dynamic lists without any duplicates in macro. I would like to load the column without duplicates in E2 then once you choose value from E2 new list would be created in E3 without any duplicates with right wall thickness. I tried to use Vlookup but it can only find first value plus I don't know how to create dynamic list in macro. Please see the figures below to see what I want to achieve.

My code:

Private Sub Worksheet_Change(ByVal Target As Range)
selectedVal = Target.Value
If Target.Address = "$E$2" Then
SelectedNum = Application.VLookup(selectedVal, Worksheets("Temp").Range("_ClassLocationPipe"), 8, False)
If Not IsError(SelectedNum) Then
Set Target = Worksheets("Wheel Load - 2 and 3 Axle").Range("E3")
Target.Value = SelectedNum
End If
End If
End Sub




2617126172

[大灰狼1976]

Hi TrueRad!
Welcome to vbax forum.
Untested.

Private Sub Worksheet_Change(ByVal Target As Range)
selectedVal = Target.Value
If Target.Address = "$E$2" Then
Dim d As Object, i&, arr
arr = Worksheets("Temp").Range("_ClassLocationPipe")
For i = 1 To UBound(arr)
If arr(i, 1) = selectedVal Then d(arr(i, 8)) = ""
Next i
If d.Count > 0 Then
With Target.Offset(1).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Join(d.keys, ",")
End With
End If
End If
End Sub

[TrueRad]

Hi 大灰狼1976
Thank you very much. It is a great forum. It stops at line 7.
26176

[大灰狼1976]

I'm sorry!

Private Sub Worksheet_Change(ByVal Target As Range)
selectedVal = Target.Value
If Target.Address = "$E$2" Then
Dim d As Object, i&, arr
Set d = CreateObject("scripting.dictionary") 'Added line
arr = Worksheets("Temp").Range("_ClassLocationPipe")
For i = 1 To UBound(arr)
If arr(i, 1) = selectedVal Then d(arr(i, 8)) = ""
Next i
If d.Count > 0 Then
With Target.Offset(1).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Join(d.keys, ",")
End With
End If
End If
End Sub

[snb]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$2" Then
on error resume next
with sheets("Temp").Range("_ClassLocationPipe")
.replace target.value,"",1
.specialcells(4).delete
end with
end if
End Sub

[TrueRad]

I'm sorry!

Private Sub Worksheet_Change(ByVal Target As Range)
selectedVal = Target.Value
If Target.Address = "$E$2" Then
Dim d As Object, i&, arr
Set d = CreateObject("scripting.dictionary") 'Added line
arr = Worksheets("Temp").Range("_ClassLocationPipe")
For i = 1 To UBound(arr)
If arr(i, 1) = selectedVal Then d(arr(i, 8)) = ""
Next i
If d.Count > 0 Then
With Target.Offset(1).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Join(d.keys, ",")
End With
End If
End If
End Sub


Thank you very much! I added a ".Value =d.Keys" to make sure value of the cell is updated every time.


Private Sub Worksheet_Change(ByVal Target As Range)
Dim d As Object, i&, arr '
If Target.Address = "$E$2" Then ' Wall Thickness
Set d = CreateObject("scripting.dictionary") ' or Set d = New Scripting.dictionary
arr = Worksheets("Temp").Range("_ClassLocationPipe")
For i = 1 To UBound(arr) - 1
If arr(i, 1) = Target.Value Then d(arr(i, 8)) = ""
Next i
If d.Count > 0 Then
With Target.Offset(1)
.Validation.Delete
.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Join(d.Keys, ",")
.Value = d.Keys 'Update the cell value
End With
End If
End If
End Sub

[TrueRad]

I tried to create a Data Validation List without any duplicates but my Code does not work. Does any one know why ?


Private Sub Workbook_Open(ByVal Target As Range)
Dim d As Object, i&, arr '
Set d = CreateObject("scripting.dictionary")
arr = Worksheets("Temp").Range("_Nompipesize")
Range("E2").Value = ""
With d
For i = 1 To UBound(arr)
If Not .Exists(i) Then d(arr(i, 1)) = ""
Next i
End With
If d.Count > 0 Then
With Range("E2")
.Validation.Delete
.Validation.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:=Join(d.Keys, ",")
.Value = d.Keys
End With
End If
End Sub

[TrueRad]

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$E$2" Then
on error resume next
with sheets("Temp").Range("_ClassLocationPipe")
.replace target.value,"",1
.specialcells(4).delete
end with
end if
End Sub


This Code removes rows from my reference table in "Temp" Sheet