How to extract multiple values from same lookup

nuckfuts

New Member
Joined
Mar 10, 2020
Messages
43
Office Version
  1. 365
Platform
  1. Windows
Hi -

I'm looking to extract multiple Unique ID's based on a few specific Values. The condensed table below shows the source data (Sheet2). Based on Values listed in Sheet1, I'd like to extract all relevant Unique ID's.

I've considered array formulas, although I try to avoid those when possible for processing speed. I've also found ways to filter the table by the values in the cells but all solutions list out each criteria/filter/Value as a separate line of code and may be extremely repetitive considering there could be 20+ values. Is there a good way to do this?

Sheet2:
1606837732160.png


Sheet1:
Value1
Value2
Value3
...
(could be 20+ values)
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,317
Office Version
  1. 365
Platform
  1. Windows
As long as you have headers in every cell A1:S1 then use
VBA Code:
Sub nuckfuts()
   Dim Ary As Variant
   Dim r As Long
   Dim Dic As Object
   
   Set Dic = CreateObject("scripting.dictionary")
   Ary = Sheets("Sheet1").Range("A1").CurrentRegion.Value2
   For r = 2 To UBound(Ary)
      Dic(Ary(r, 1)) = Empty
   Next r
   Ary = Sheets("Sheet2").Range("A1").CurrentRegion.Value2
   With CreateObject("scripting.dictionary")
      For r = 2 To UBound(Ary)
         If Dic.Exists(Ary(r, 19)) Then .Item(Ary(r, 1)) = Empty
      Next r
      Sheets("Sheet1").Range("B2").Resize(.Count).Value = Application.Transpose(.Keys)
   End With
End Sub
This also ignores the header in A1 on sheet1
 
Solution

Some videos you may like

Excel Facts

Move date out one month or year
Use =EDATE(A2,1) for one month later. Use EDATE(A2,12) for one year later.

nuckfuts

New Member
Joined
Mar 10, 2020
Messages
43
Office Version
  1. 365
Platform
  1. Windows
As long as you have headers in every cell A1:S1 then use
VBA Code:
Sub nuckfuts()
   Dim Ary As Variant
   Dim r As Long
   Dim Dic As Object
  
   Set Dic = CreateObject("scripting.dictionary")
   Ary = Sheets("Sheet1").Range("A1").CurrentRegion.Value2
   For r = 2 To UBound(Ary)
      Dic(Ary(r, 1)) = Empty
   Next r
   Ary = Sheets("Sheet2").Range("A1").CurrentRegion.Value2
   With CreateObject("scripting.dictionary")
      For r = 2 To UBound(Ary)
         If Dic.Exists(Ary(r, 19)) Then .Item(Ary(r, 1)) = Empty
      Next r
      Sheets("Sheet1").Range("B2").Resize(.Count).Value = Application.Transpose(.Keys)
   End With
End Sub
This also ignores the header in A1 on sheet1
This is working perfectly! I tried to figure out how to adjust it myself but this is far beyond my VBA understanding - thanks!
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,317
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,123,391
Messages
5,601,391
Members
414,448
Latest member
Jessica 22664

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
Top