Changing this code so that it can do multiple dropdowns.

**UsmanBPD** · 06-28-2012, 08:09 AM

Hello everybody, I have this code :

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim lastrow As Long
    Dim rngList As Range
    
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    
    Set rngList = Range("AB3").CurrentRegion
    
    If Target.Cells.Count > 1 Then Exit Sub
    
    On Error Resume Next
    
    If Not Intersect(Target, Range("B18:B19")) Is Nothing Then  ' user is in column-B
        Target.Value = Application.WorksheetFunction.VLookup(Target.Value, rngList, 2, False)
    End If
    
    Set rngList = Nothing
    
End Sub

Basically the code, takes the dropdown from the cells below, then does a vlookup to grab the value to the right of the cell. This is so the user doesn't have to memorise "48583" but can just select "Flats" and 48583 is selected from the cell next to it. But at the moment ,the code can only do 2 of the cells from the same range, I would like it to be able to do all of the below ranges, I have only managed to get it working on the first one, any help would be appreciated.

B18:B19 should grab data from AB3 downwards

B20:B21 should grab data from AE3 downwards

B22:B23 should grab data from AH3 downwards

H9:H10 should grab data from BC2 downwards.

If there is also a simpler way to do this without VBA also, this would be appreciated.

1 EXAMPLE.xlsx

**royUK** · 06-28-2012, 08:18 AM

There's actually no code in the sheet and I can't figure out what you expect from the code. Certainly putting it into your example doesn't work for me.

**UsmanBPD** · 06-28-2012, 11:36 AM

I will attach the file we are using at the moment.

personalb.xlsm

Here is the code that is working for the eBay category 1 and 2, and the recommended-browse node 1 and 2, but not BPD Store Category 1 and 2, or SD Store Category 1 and 2.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim lastrow As Long
    Dim rngList As Range
    
'    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    
    Set rngList = Range("AB3").CurrentRegion
    
    If Target.Cells.Count > 1 Then Exit Sub
    
    On Error Resume Next
    
    If Not Intersect(Target, Range("B18:B19")) Is Nothing Then  ' user is in column-B
        Target.Value = Application.WorksheetFunction.VLookup(Target.Value, rngList, 2, False)
    End If
    
    Set rngList = Nothing
    
'End Sub


    
'Private Sub Worksheet_Change2(ByVal Target As Range)

'    Dim lastrow As Long
'    Dim rngList As Range
    
'    lastrow = Cells(Rows.Count, "B:C").End(xlUp).Row
    
    Set rngList = Range("AE3").CurrentRegion
    
    If Target.Cells.Count > 1 Then Exit Sub
    
    On Error Resume Next
    
    If Not Intersect(Target, Range("B20:B21")) Is Nothing Then  ' user is in column-B
        Target.Value = Application.WorksheetFunction.VLookup(Target.Value, rngList, 2, False)
    End If
    
    Set rngList = Nothing
    
'End Sub


    
'Private Sub Worksheet_Change2(ByVal Target As Range)

'    Dim lastrow As Long
'    Dim rngList As Range
    
'    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    
    Set rngList = Range("AH3").CurrentRegion
    
    If Target.Cells.Count > 1 Then Exit Sub
    
    On Error Resume Next
    
    If Not Intersect(Target, Range("B22:B23")) Is Nothing Then  ' user is in column-B
        Target.Value = Application.WorksheetFunction.VLookup(Target.Value, rngList, 2, False)
    End If
    
    Set rngList = Nothing
    
'End Sub


    
'Private Sub Worksheet_Change2(ByVal Target As Range)

'    Dim lastrow As Long
'    Dim rngList As Range
    
'    lastrow = Cells(Rows.Count, "H").End(xlUp).Row
    
    Set rngList = Range("BC3").CurrentRegion
    
    If Target.Cells.Count > 1 Then Exit Sub
    
    On Error Resume Next
    
    If Not Intersect(Target, Range("H9:H10")) Is Nothing Then  ' user is in column-B
        Target.Value = Application.WorksheetFunction.VLookup(Target.Value, rngList, 2, False)
    End If
    
    Set rngList = Nothing
    
End Sub