Vlookup with multiple occurances of a value

[Hyp40]

Hi. I have a master postcode list and have been using Vlookup to check if my postcode is in the master list and to bring back info from neighbouring cells in the master postcode list. This was working well until I found that my postcode could occur more than once in the master list (with different info in the neighbouring cells). How can I get each of these back rather than just the first one? Also, some cells in the master list contain a number of postcodes, separated by commas. The vlookup doesn't find any of these. The master list changes weekly, so it is impractical to separate out the cells with multiple postcodes in.

 

[Hyp40]

It is a list of postcodes, so yes, I understand the problem. Could the extra results go at the bottom of the list, or in the next column perhaps?

 

[Fluff]

Ok, how about

Sub Hyp40()
   Dim Cl As Range
   Dim Ws1 As Worksheet, Ws2 As Worksheet
   Dim Sp As Variant
   Dim i As Long
   
   Set Ws1 = Sheets("[COLOR=#ff0000]Master[/COLOR]")
   Set Ws2 = Sheets("[COLOR=#ff0000]Sheet1[/COLOR]")
   With CreateObject("Scripting.dictionary")
      For Each Cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))
         Sp = Split(Cl.Value, ",")
         For i = 0 To UBound(Sp)
            If Not .Exists(Trim(Sp(i))) Then
               .Add Sp(i), Cl.Offset(, 1).Resize(, 3)
            Else
               Set .Item(Trim(Sp(i))) = Union(.Item(Trim(Sp(i))), Cl.Offset(, 1).Resize(, 3))
            End If
         Next i
      Next Cl
      For Each Cl In Ws2.Range("A2", Ws2.Range("A" & Rows.Count).End(xlUp))
         If .Exists(Cl.Value) Then
            Ws2.Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(.Item(Cl.Value).Count / 3, 1).Value = Cl.Value
            .Item(Cl.Value).Copy Ws2.Range("C" & Rows.Count).End(xlUp).Offset(1)
         End If
      Next Cl
   End With
End Sub

Change sheet names to suit

 

[Hyp40]

Wow thank you Fluff, that certainly solves the problem. Amazing.
I have been struggling for days with this. Thank you so much.
Now to see if I can work out what the code is doing!

 

[Fluff]

It already does that

 

[Hyp40]

Sorry Fluff - I was so excited that I didn't check the output properly. It does it all! I amended my reply - but not soon enough.
Thank you

 

[Fluff]

Glad to help & thanks for the feedback

 

[Hyp40]

Hi Fluff, sorry to trouble you again.
Is there a maximum number of rows I can search on? This works perfectly on my sample data but when I try it on the actual data, I get "Run-time error '457': This key is already associated with an element of this collection". This seems to happen if I have more than 1450 rows in the Master List.
My Master list has 66000 rows and the look up list has around 5000 rows.

 

[Fluff]

There was a slight flaw in the code, try

Sub Hyp40()
   Dim Cl As Range
   Dim Ws1 As Worksheet, Ws2 As Worksheet
   Dim Sp As Variant
   Dim i As Long
   
   Set Ws1 = Sheets("RC")
   Set Ws2 = Sheets("Form")
   With CreateObject("Scripting.dictionary")
      For Each Cl In Ws1.Range("A2", Ws1.Range("A" & Rows.Count).End(xlUp))
         Sp = Split(Cl.Value, ",")
         For i = 0 To UBound(Sp)
            If Not .Exists(Trim(Sp(i))) Then
               .Add [COLOR=#0000ff]Trim(Sp(i))[/COLOR], Cl.Offset(, 1).Resize(, 3)
            Else
               Set .Item(Trim(Sp(i))) = Union(.Item(Trim(Sp(i))), Cl.Offset(, 1).Resize(, 3))
            End If
         Next i
      Next Cl
      For Each Cl In Ws2.Range("A2", Ws2.Range("A" & Rows.Count).End(xlUp))
         If .Exists(Cl.Value) Then
            Ws2.Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(.Item(Cl.Value).Count / 3, 1).Value = Cl.Value
            .Item(Cl.Value).Copy Ws2.Range("C" & Rows.Count).End(xlUp).Offset(1)
         End If
      Next Cl
   End With
End Sub

 

[Hyp40]

Thank you Fluff. That has worked perfectly. Can't say that I understand the slight difference but you have made my weekend. I'm really grateful

 

[Fluff]

If you have data like
PE14 8PS, PE12 0JW
This line

If Not .Exists(Trim(Sp(i))) Then

will trim the value so it will check for "PE14 8PS" and "PE12 0JW", if the 2nd value didn't exist it would add " PE12 0JW" (note the space at the start) rather than "PE12 0JW"
So the mod I made corrects that problem.