Solved: Vlookup for Duplicates

[Gusty]

Hi there

I need to do a lookup from an advice note number held in a list in one sheet, to the second list held in sheet 2 , of advice notes with their corresponding invoice numbers against them. Some advice notes have up to 5 0r 6 separate invoices against them. Have looked at vlookupnth which is almost there. However i want the results to be held in one cell ie Invoice 123, Invoice 234 etc . Perhaps concatenated I dont know?

All suggestions greatly received

[mdmackillop]

Hi Gusty,
Welcome to VBAX.
Can you post a sample of your data? Use Manage Attachments in the Go Advanced section.
Regards
MD

[Gusty]

Sorry to be thick where is the go advanced section located?


Thanks

[mdmackillop]

Under the Message Box

[Gusty]

Good morning Mdmac ! Must be blind! Please see attached file which explains what I am trying to do.

[anandbohra]

Hi Try this one

I am attaching your same file with inclusion of this function along with example.

[VBA]Function Manylookup(lookup_Value As Variant, lookup_range As Range, column_no As Integer) As Variant
Dim xVal As Variant
Dim myColl As New Collection

On Error Resume Next
For Each xVal In lookup_range
If CStr(xVal.Value) = CStr(lookup_Value.Value) Then
myColl.Add Item:=xVal.Offset(0, column_no - 1)
End If
Next xVal
On Error GoTo 0

For Each xVal In myColl
Manylookup = Manylookup & " " & xVal
Next xVal

End Function
[/VBA]

[anandbohra]

advanced with delimeter option to split result in future
delimeter like space, comma, semicolon, pipe, hash etc. etc

[vba]Function Manylookup(lookup_Value As Variant, lookup_range As range, column_no As Integer, delimeter_val As Variant) As Variant
Dim xVal As Variant
Dim myColl As New Collection

On Error Resume Next
For Each xVal In lookup_range
If CStr(xVal.Value) = CStr(lookup_Value.Value) Then
myColl.Add Item:=xVal.Offset(0, column_no - 1)
End If
Next xVal
On Error GoTo 0

For Each xVal In myColl
Manylookup = Manylookup & delimeter_val & xVal
Next xVal
Manylookup = Right(Manylookup, Len(Manylookup) - Len(delimeter_val))
End Function

[/vba]

[Gusty]

Many Thanks my friend - much respect to you! Your solution works a treat!

[mdmackillop]

Alternative using a Change Event for Column D. You can remove the repeated "Invoice" text by using the alternate code line.
Please note that this will not update if more items are added to the Invoice Number sheet, so the function may be more applicable.
[vba]Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim r As Range, cel As Range, txt As String
If Target.Column = 4 Then
With Sheets("Invoice Number")
.Columns("A:F").AutoFilter Field:=4, Criteria1:=Target
Set r = .Range(.Cells(2, 6), .Cells(Rows.Count, 6).End(xlUp)).SpecialCells(xlCellTypeVisible)
For Each cel In r
txt = txt & cel & ", "
'To remove "Invoice", use this line instead
'txt = txt & Split(cel)(1) & ", "
Next
Target.Offset(, 7) = Left(txt, Len(txt) - 2)
.Columns("A:F").AutoFilter
End With
End If
End Sub
[/vba]