Can vlookup return more than one value

[Closed]
Report
-
Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
-
Hello,
I am wondering if anyone can help me find a way to modify a vlookup to return more than one value? I currently have two spreadsheets with one value in common. I have a spreadsheet that has several columns of data that I would like returned to the main sheet.

Thank you for any help you may be able to give.


1 reply

Posts
1864
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
802
it can be done . there is a good but little complex formula which may be difficult to modify to suit the user's needs.

I have given amacro below . You can modify to suit you ..

try this on this experimental data from A1 b1 up to A9 B9. if it is ok modify to suit your data.


name anount
JOHN 1
BILL 2
TOM 3
TOM 4
BILL 5
JOHN 6
BILL 7
TOM 8


there are four macros. RUN ONLY "FULL_MACRO".
you can run macro "undo" and run again "full_macro" for rechecking
see columns g and beyond


Sub unique_values()
Dim rng As Range, dest As Range
Worksheets("sheet1").Activate
Set rng = Range(Range("a1"), Range("a1").End(xlDown))
Set dest = Range("a1").End(xlDown).Offset(5, 0)
rng.AdvancedFilter action:=xlFilterCopy, copytorange:=dest, unique:=True
Range(dest.Offset(1, 0), dest.End(xlDown)).Copy
Range("a1").End(xlToRight).Offset(0, 5).PasteSpecial Transpose:=True
End Sub

Sub vlookup_all_values()
Dim rng As Range, c As Range, rng1 As Range, rng2 As Range
Dim cfind As Range, add As String
Worksheets("sheet1").Activate
Set rng2 = Range(Range("a1"), Range("a1").End(xlDown))
Set rng = Range("a1").End(xlToRight).Offset(0, 5)
'msgbox rng.Address
Set rng1 = Range(rng, rng.End(xlToRight))
'msgbox rng1.Address
For Each c In rng1
Set cfind = rng2.Cells.Find(what:=c.Value, lookat:=xlWhole)
On Error Resume Next
If cfind Is Nothing Then GoTo line1
add = cfind.Address
'msgbox add
rng1.Cells.Find(what:=cfind, lookat:=xlWhole).Offset(1, 0) = cfind.Offset(0, 1)
Do
Set cfind = rng2.Cells.FindNext(cfind)
'msgbox cfind
'msgbox cfind.Address

If cfind Is Nothing Then GoTo line1
If cfind.Address = add Then GoTo line1
Cells.Find(what:=cfind, lookat:=xlWhole).End(xlDown).Offset(1, 0) = cfind.Offset(0, 1)
Loop
line1:
Next
End Sub



Sub full_macro()
unique_values
vlookup_all_values
MsgBox "vlookup macro is over"
End Sub


Sub undo()
Range(Range("A1").End(xlDown).Offset(1, 0), Cells(Rows.Count, "A")).EntireRow.Delete
Range(Range("G1"), Cells(1, Columns.Count)).EntireColumn.Delete
End Sub