VBA one vlookup for multiple cells

wtom0412

Board Regular
Joined
Jan 3, 2015
Messages
180
Office Version
  1. 365
Platform
  1. Windows
Hi All,

I am wondering if it is possible to have one vlookup which can take its reference from a range of cells (B5:B12) and enter the values relative to the reference cell?

For example, I need to be able to enter a product code in in B5 and have cells in C5:F5 get looked up values, and if a code is entered into B6, the cells in C6:F6.

I need to do the same as above in C5:C12 as well.

At the moment, I am getting an Out of Stack error because I have too many IF Statements running (I think that's the reason).

I am thinking that a cell.offset type command could be used, but I can't get my head around that.

The other thought I had was this would probably work better with a Case Statement rather than a million IF Statements (but again, can't get my head around complex Case Statements).

There are 16 versions of the following Vlookup code...

Code:
[Sub AAFCANSMultipleProductLookup1()
On Error GoTo ErrorHandler:

LookupValue = Range("B5:B12")
LookupRange = Sheet2.Range("A2:O3000")

'Approved Product
If Range("B5") <> "" Then
ApprovedProductLookup = Application.WorksheetFunction.VLookup(LookupValue, LookupRange, 9, False)
Range("G5") = ApprovedProductLookup

'Vendor Product Number
VendorCodeLookup = Application.WorksheetFunction.VLookup(LookupValue, LookupRange, 10, False)
Range("C5") = VendorCodeLookup

'Product Name
ProductNameLookup = Application.WorksheetFunction.VLookup(LookupValue, LookupRange, 2, False)
Range("D5") = ProductNameLookup

'Supplier Name
SupplierNameLookup = Application.WorksheetFunction.VLookup(LookupValue, LookupRange, 3, False)
Range("E5") = SupplierNameLookup
Range("F5").Select

End If

ErrorHandler:
If Err.Number = 1004 Then
Range("C5") = "Please Enter Vendor Product Code"
Range("D5") = "Please Enter Product Name"
Range("B5").ClearContents
Range("C5").Select
End If

End Sub
/CODE]

I then use the following Worksheet Change Event to call one of the 16 Sub's 

[CODE][Private Sub Worksheet_Change(ByVal Target As Range)

Static KeyCells1 As Range, KeyCells2 As Range, KeyCells3 As Range, KeyCells4 As Range, _
KeyCells5 As Range, KeyCells6 As Range, KeyCells7 As Range, KeyCells8 As Range

Static KeyCells11 As Range, KeyCells12 As Range, KeyCells13 As Range, KeyCells14 As Range, _
KeyCells15 As Range, KeyCells16 As Range, KeyCells17 As Range, KeyCells18 As Range

Set KeyCells1 = Range("B5")
Set KeyCells2 = Range("B6")
Set KeyCells3 = Range("B7")
Set KeyCells4 = Range("B8")
Set KeyCells5 = Range("B9")
Set KeyCells6 = Range("B10")
Set KeyCells7 = Range("B11")
Set KeyCells8 = Range("B12")

Set KeyCells11 = Range("C5")
Set KeyCells12 = Range("C6")
Set KeyCells13 = Range("C7")
Set KeyCells14 = Range("C8")
Set KeyCells15 = Range("C9")
Set KeyCells16 = Range("C10")
Set KeyCells17 = Range("C11")
Set KeyCells18 = Range("C12")

    If Not Application.Intersect(KeyCells1, Range(Target.Address)) Is Nothing Then
        Run "AAFCANSMultipleProductLookup1"
       
    End If
    
    If Not Application.Intersect(KeyCells2, Range(Target.Address)) Is Nothing Then
        Run "AAFCANSMultipleProductLookup2"
       
    End If
    If Not Application.Intersect(KeyCells3, Range(Target.Address)) Is Nothing Then
        Run "AAFCANSMultipleProductLookup3"
       
    End If
    
    If Not Application.Intersect(KeyCells4, Range(Target.Address)) Is Nothing Then
        Run "AAFCANSMultipleProductLookup4"
       
    End If
    
    If Not Application.Intersect(KeyCells5, Range(Target.Address)) Is Nothing Then
        Run "AAFCANSMultipleProductLookup5"
       
    End If
    
    If Not Application.Intersect(KeyCells6, Range(Target.Address)) Is Nothing Then
        Run "AAFCANSMultipleProductLookup6"
       
    End If
    
    If Not Application.Intersect(KeyCells7, Range(Target.Address)) Is Nothing Then
        
        Run "AAFCANSMultipleProductLookup7"
       
    End If
    
    If Not Application.Intersect(KeyCells8, Range(Target.Address)) Is Nothing Then
        Run "AAFCANSMultipleProductLookup8"
       
    End If
'
    If Not Application.Intersect(KeyCells11, Range(Target.Address)) _
           Is Nothing Then
    Run "VendorMultipleProductLookup1"
'
    End If
    If Not Application.Intersect(KeyCells12, Range(Target.Address)) _
        Is Nothing Then

   Run "VendorMultipleProductLookup2"
    End If
    If Not Application.Intersect(KeyCells13, Range(Target.Address)) _
        Is Nothing Then

        Run "VendorMultipleProductLookup3"
    End If
    If Not Application.Intersect(KeyCells14, Range(Target.Address)) _
        Is Nothing Then

        Run "VendorMultipleProductLookup4"
    End If
    If Not Application.Intersect(KeyCells15, Range(Target.Address)) _
        Is Nothing Then

        Run "VendorMultipleProductLookup5"
    End If
    If Not Application.Intersect(KeyCells16, Range(Target.Address)) _
        Is Nothing Then

        Run "VendorMultipleProductLookup6"
    End If
    If Not Application.Intersect(KeyCells17, Range(Target.Address)) _
        Is Nothing Then
 
        Run "VendorMultipleProductLookup7"
    End If
    If Not Application.Intersect(KeyCells8, Range(Target.Address)) _
        Is Nothing Then

        Run "VendorMultipleProductLookup8"
    End If
End Sub
/CODE]

I hope the above makes sense.

Thank you for your consideration.


Cheers

WT
 

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.
The "Out of stack space" message doesn't appear that easily; it will not get triggered by nested If's but by nested function calls (each function call sets up a stack frame for that call, so nesting too many function calls makes you run out of the available stack space). And even that has a high limit; you'd expect at least a thousand nests to be possible. So this tells us something fishy is going on here...

The code flow in your macro is that whenever a cell changes, the Worksheet_Change event is being fired. When handling this, you call your VLookup wrapping code, and place it's result back on the sheet. And that's where it goes sour: your own modification of the sheet probably triggers a new Worksheet_Change event, which in turn calls your code, which in turn updates the sheet, ...

You can use the Application.EnableEvents property to disable events temporarily. Disabling this at the start of your event code, you are free to change whatever you want on the sheet without getting into this kind of loop. Do not forget to enable it again once you're done. Another possibility is to track whether you're changing things yourself is by noting it in a global somewhere; e.g. have a global "Private selfModifying As Boolean" somewhere, and query & set it within the event handler. Same effect, but leaves Excel's event handling intact, might you need it for something else.
 
Upvote 0

Forum statistics

Threads
1,214,864
Messages
6,121,984
Members
449,058
Latest member
oculus

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top