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)
 

Some videos you may like

Excel Facts

What did Pito Salas invent?
Pito Salas, working for Lotus, popularized what would become to be pivot tables. It was released as Lotus Improv in 1989.

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
605
Office Version
  1. 2016
Platform
  1. Windows
Code using VBA
This code will look for all the Value listed on Sheet1. Extract data from Sheet2 and create result in a sheet called Result

VBA Code:
Sub ExtractValue()

Dim n As Long
Dim cellValue As Range, cellID As Range, rngValue As Range, rngID As Range
Dim wb As Workbook
Dim wsData As Worksheet, wsValue As Worksheet, wsResult As Worksheet

Set wb = ThisWorkbook
Set wsValue = wb.Sheets("Sheet1")
Set wsData = wb.Sheets("Sheet2")

Set rngValue = wsValue.Range("A1", "A" & wsValue.Range("A1").End(xlDown).Row)
Set rngID = wsData.Range("B2", "B" & wsData.Range("B1").End(xlDown).Row)

wb.Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Result"
Set wsResult = wb.Sheets("Result")

wsResult.Range("A1") = "Value"
wsResult.Range("B1") = "Unique ID"
n = 1

For Each cellValue In rngValue
    wsResult.Range("A" & n + 1) = cellValue
    For Each cellID In rngID
        If cellID = cellValue Then
            n = n + 1
            wsResult.Range("B" & n) = cellID.Offset(0, -1)
        End If
    Next
Next

End Sub
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,317
Office Version
  1. 365
Platform
  1. Windows
How about
+Fluff v2.xlsm
ABCDEF
1PostcodeCounty
2CA11 0SACumbriaCumbriaCA11 0SA
3DY14 0JBShropshireWest YorkshireOL14 6XB
4EX22 7NBDevonSurreyBD12 8DW
5OL14 6XBWest YorkshireCR3 9BS
6BD12 8DWWest YorkshireHD8 8EB
7PL18 9HRCornwallHD7 6DB
8SK6 7HWGreater ManchesterBD4 6JF
9TN27 0HWKentCA10 3JE
10BB1 8JRLancashire
11NE19 2LSNorthumberland
12BA4 4FGSomerset
13CR3 9BSSurrey
14DH9 6TQCounty Durham
15ST1 2HTStaffordshire
16RG9 6YJBuckinghamshire
17TN16 3DXGreater London
18BB8 0PGLancashire
19DL6 3AQNorth Yorkshire
20ST8 6JAStaffordshire
21B31 5HYWest Midlands
22HD8 8EBWest Yorkshire
23PL32 9RHCornwall
24HD7 6DBWest Yorkshire
25BB12 9QJLancashire
26YO18 8RENorth Yorkshire
27ST6 8LBStaffordshire
28WS12 2EWStaffordshire
29BD4 6JFWest Yorkshire
30CA10 3JECumbria
31
Main
Cell Formulas
RangeFormula
F2:F9F2=UNIQUE(FILTER(A2:A30,COUNTIF(E2:E4,B2:B30)))
Dynamic array formulas.
 

nuckfuts

New Member
Joined
Mar 10, 2020
Messages
43
Office Version
  1. 365
Platform
  1. Windows
Code using VBA
This code will look for all the Value listed on Sheet1. Extract data from Sheet2 and create result in a sheet called Result

VBA Code:
Sub ExtractValue()

Dim n As Long
Dim cellValue As Range, cellID As Range, rngValue As Range, rngID As Range
Dim wb As Workbook
Dim wsData As Worksheet, wsValue As Worksheet, wsResult As Worksheet

Set wb = ThisWorkbook
Set wsValue = wb.Sheets("Sheet1")
Set wsData = wb.Sheets("Sheet2")

Set rngValue = wsValue.Range("A1", "A" & wsValue.Range("A1").End(xlDown).Row)
Set rngID = wsData.Range("B2", "B" & wsData.Range("B1").End(xlDown).Row)

wb.Sheets.Add(After:=Sheets(Sheets.Count)).Name = "Result"
Set wsResult = wb.Sheets("Result")

wsResult.Range("A1") = "Value"
wsResult.Range("B1") = "Unique ID"
n = 1

For Each cellValue In rngValue
    wsResult.Range("A" & n + 1) = cellValue
    For Each cellID In rngID
        If cellID = cellValue Then
            n = n + 1
            wsResult.Range("B" & n) = cellID.Offset(0, -1)
        End If
    Next
Next

End Sub
I gave it a shot but don't think it's running correctly - or perhaps it is and it just takes a really long time to run. My source data has ~8k rows of data but it seems like it's trying to process more than it should. Had to quit Excel both times due to it freezing up for so long.
 

nuckfuts

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

ADVERTISEMENT

How about
+Fluff v2.xlsm
ABCDEF
1PostcodeCounty
2CA11 0SACumbriaCumbriaCA11 0SA
3DY14 0JBShropshireWest YorkshireOL14 6XB
4EX22 7NBDevonSurreyBD12 8DW
5OL14 6XBWest YorkshireCR3 9BS
6BD12 8DWWest YorkshireHD8 8EB
7PL18 9HRCornwallHD7 6DB
8SK6 7HWGreater ManchesterBD4 6JF
9TN27 0HWKentCA10 3JE
10BB1 8JRLancashire
11NE19 2LSNorthumberland
12BA4 4FGSomerset
13CR3 9BSSurrey
14DH9 6TQCounty Durham
15ST1 2HTStaffordshire
16RG9 6YJBuckinghamshire
17TN16 3DXGreater London
18BB8 0PGLancashire
19DL6 3AQNorth Yorkshire
20ST8 6JAStaffordshire
21B31 5HYWest Midlands
22HD8 8EBWest Yorkshire
23PL32 9RHCornwall
24HD7 6DBWest Yorkshire
25BB12 9QJLancashire
26YO18 8RENorth Yorkshire
27ST6 8LBStaffordshire
28WS12 2EWStaffordshire
29BD4 6JFWest Yorkshire
30CA10 3JECumbria
31
Main
Cell Formulas
RangeFormula
F2:F9F2=UNIQUE(FILTER(A2:A30,COUNTIF(E2:E4,B2:B30)))
Dynamic array formulas.
I've been hoping to avoid the array formulas as they have slowed down my spreadsheet in the past. When I try to array formula is says "That function isn't valid." highlighting the "filter" in the formula.. My source data is on another sheet if that changes anything.
I'm also running Office 365 MSO 64-bit so now sure what's wrong.
 

Zot

Well-known Member
Joined
Nov 26, 2020
Messages
605
Office Version
  1. 2016
Platform
  1. Windows
I gave it a shot but don't think it's running correctly - or perhaps it is and it just takes a really long time to run. My source data has ~8k rows of data but it seems like it's trying to process more than it should. Had to quit Excel both times due to it freezing up for so long.

Sorry. The code works and I have tried it but for several line mock up data I created. You can speed up execution by adding bold lines. I should have include them. Standard line in most code

VBA Code:
Dim n As Long
Dim cellValue As Range, cellID As Range, rngValue As Range, rngID As Range
Dim wb As Workbook
Dim wsData As Worksheet, wsValue As Worksheet, wsResult As Worksheet

[B]Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
[/B]
Set wb = ThisWorkbook
Set wsValue = wb.Sheets("Sheet1")
Set wsData = wb.Sheets("Sheet2")

' [I]Rest of the codes[/I]

            wsResult.Range("B" & n) = cellID.Offset(0, -1)
        End If
    Next
Next

[B]Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic[/B]

End Sub

Note that if the program is interrupted before finishing, the Excel will still be in xlCalculationManual. Any equation will not be calculated automatically until you manually tell so by pressing F9. You can change the Excel mode to auto again File > Option > Formulas there...
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,317
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

I'm also running Office 365 MSO 64-bit so now sure what's wrong.

You obviously don't have the latest update(s)
How about
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 = 1 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, 2)) Then .Item(Ary(r, 1)) = Empty
      Next r
      Sheets("Sheet1").Range("B2").Resize(.Count).Value = Application.Transpose(.Keys)
   End With
End Sub
 

nuckfuts

New Member
Joined
Mar 10, 2020
Messages
43
Office Version
  1. 365
Platform
  1. Windows
You obviously don't have the latest update(s)
How about
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 = 1 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, 2)) Then .Item(Ary(r, 1)) = Empty
      Next r
      Sheets("Sheet1").Range("B2").Resize(.Count).Value = Application.Transpose(.Keys)
   End With
End Sub
I get a run-time error '13' for a type mismatch on this line:
VBA Code:
Sheets("Sheet1").Range("B2").Resize(.Count).Value = Application.Transpose(.Keys)
Let me know if the following assumptions from the code mirror your setup:
Sheet1: Where values are, starting in A2 (column header in A1)
Sheet2: Where Unique ID's are, starting in A2 (column header in A1)
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
53,317
Office Version
  1. 365
Platform
  1. Windows
I've assumed that sheet2 is laid out as per your op & that sheet1 has values in A1 downwards that match values in col B on sheet2
 

nuckfuts

New Member
Joined
Mar 10, 2020
Messages
43
Office Version
  1. 365
Platform
  1. Windows
I've assumed that sheet2 is laid out as per your op & that sheet1 has values in A1 downwards that match values in col B on sheet2
That makes sense - I was using it like that but I put "Value" as a column header on Sheet1 and that's what was giving me the error. Is there anyway to have the array lookup a different column? Say if the Values are in row "S" rather than "B" as shown in my OP?
 

Watch MrExcel Video

Forum statistics

Threads
1,123,380
Messages
5,601,291
Members
414,440
Latest member
Kim0204

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