Can vlookup return more than one value
Closed
kimike1
-
Nov 10, 2010 at 01:07 PM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Nov 10, 2010 at 09:50 PM
venkat1926 Posts 1863 Registration date Sunday June 14, 2009 Status Contributor Last seen August 7, 2021 - Nov 10, 2010 at 09:50 PM
Related:
- Can vlookup return more than one value
- Thunderbird return receipt - Guide
- Display two columns in data validation list but return only one - Guide
- Flipkart return policy - Guide
- What function can automatically return the value in cell c77 ✓ - Excel Forum
- Help me to add particular cells ✓ - Excel Forum
1 response
venkat1926
Posts
1863
Registration date
Sunday June 14, 2009
Status
Contributor
Last seen
August 7, 2021
811
Nov 10, 2010 at 09:50 PM
Nov 10, 2010 at 09:50 PM
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
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
