PDA

View Full Version : Solved: Vlookup for Duplicates



Gusty
11-28-2007, 07:30 AM
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
11-28-2007, 11:56 AM
Hi Gusty,
Welcome to VBAX.
Can you post a sample of your data? Use Manage Attachments in the Go Advanced section.
Regards
MD

Gusty
11-28-2007, 03:35 PM
Sorry to be thick where is the go advanced section located?


Thanks

mdmackillop
11-28-2007, 03:42 PM
Under the Message Box

Gusty
11-29-2007, 02:06 AM
Good morning Mdmac ! Must be blind! Please see attached file which explains what I am trying to do.

anandbohra
11-29-2007, 02:35 AM
Hi Try this one

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

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

anandbohra
11-29-2007, 02:52 AM
advanced with delimeter option to split result in future
delimeter like space, comma, semicolon, pipe, hash etc. etc

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

Gusty
11-29-2007, 04:21 AM
Many Thanks my friend - much respect to you! Your solution works a treat!

mdmackillop
11-29-2007, 04:58 AM
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.
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