How do I Lookup next values in Excel?

M

mwl

I've got a worksheet containing data similar to the following:

Name1 Name2
Mark Sharon
John Tracy
Mark Tracy
Mark Chloe
Paul Emma
Paul Stuart

What I am trying to do is, on a new worksheet, obtain each unique name from
Name1 and place it in column C. Beneath each unique name, I want to list the
value(s) from Name2 in the cells in column B.

The result should look something like:

Mark
sharon
Tracy
Chloe
John
Tracy
Paul
Emma
Stuart

Is it possible to do this in excel?
 
J

Jayarama Vytla

Hi,

It's not so simple macro. But I will do it for you tomorrow.

Best Regards,
Jay
 
M

Mike H

Try this

Alt + f11 to open VB editor. Right click 'This Workbook' and insert module
and paste this on on the right and run it

Copies the date from sheet 1 to sheet 2 so change that to suit

Sub sonic()
Sheets("Sheet1").Activate
lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Range("A1:A" & lastrow).Copy Destination:=Sheets("Sheet2").Range("B1")
Range("B1:B" & lastrow).Copy Destination:=Sheets("Sheet2").Range("A1")
Sheets("Sheet2").Activate
Columns("A:B").Sort Key1:=Range("B1"), Order1:=xlAscending
For x = 1 To lastrow
For y = x + 1 To lastrow
If Cells(x, 2) = Cells(y, 2) Then
Cells(y, 2).ClearContents
End If
Next
Next
End Sub

Mike
 
M

mwl

Thanks for the code Mike. Unfortunately this doesn't quite meet my needs.

I've tested this out with the following data:

A B
1 Mark Test
2 Mark Test 2
3 John Test

The result from your code provides the following:

A B
1 Test John
2 Test Mark
3 Test2

The result I'd like to get are:

A B
1 John
2 Test
3 Mark
4 Test
5 Test2

Any ideas how to change you code to achieve this?
 
M

Mike H

Hi,

Test it agin with this

Sub sonic()
Sheets("Sheet1").Activate
lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Range("A1:A" & lastrow).Copy Destination:=Sheets("Sheet2").Range("B1")
Range("B1:B" & lastrow).Copy Destination:=Sheets("Sheet2").Range("A1")
Sheets("Sheet2").Activate
Columns("A:B").Sort Key1:=Range("B1"), Order1:=xlAscending
For x = 1 To lastrow
For y = x + 1 To lastrow
If Cells(x, 2) = Cells(y, 2) Then
Cells(y, 2).ClearContents
End If
Next
Next
lastrow = Cells(Cells.Rows.Count, "B").End(xlUp).Row
Set myrange = Range("B2:B" & lastrow)
For Each c In myrange
If c.Offset(-1, 0) <> "" Then
c.Insert Shift:=xlDown
End If
Next
Range("A1").Insert Shift:=xlDown
lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set myrange = Range("A2:A" & lastrow)
For Each c In myrange
If c.Offset(, 1) <> "" Then
c.Insert Shift:=xlDown
End If
Next
End Sub


Mike
 
M

mwl

Hi Mike,

That's worked. Many thanks for doing this.

Is it possible to extend the coding to incorporate 2 more fields?

A B C D
1 Mark Test 18-08-08 0.5
2 Mark Test 2 28-08-08 3
3 John Test 18-08-08 0.5

The result I'd like to get are:

A B C D E
1 John
2 Test 18-08-08 0.5
3 Mark
4 Test 18-08-08 0.5
5 Test2 25-08-08 3
 
M

Mike H

Hi,

I'm beginning to acquire a feeling of ownership of this workbook :) Try this

Sub marine()
Sheets("Sheet1").Activate
lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Range("A1:A" & lastrow).Copy Destination:=Sheets("Sheet2").Range("B1")
Range("B1:B" & lastrow).Copy Destination:=Sheets("Sheet2").Range("A1")
Range("C1:C" & lastrow).Copy Destination:=Sheets("Sheet2").Range("C1")
Range("D1:D" & lastrow).Copy Destination:=Sheets("Sheet2").Range("D1")
Sheets("Sheet2").Activate
Columns("A:B").Sort Key1:=Range("B1"), Order1:=xlAscending
For x = 1 To lastrow
For y = x + 1 To lastrow
If Cells(x, 2) = Cells(y, 2) Then
Cells(y, 2).ClearContents
End If
Next
Next
lastrow = Cells(Cells.Rows.Count, "B").End(xlUp).Row
Set myrange = Range("B2:B" & lastrow)
For Each c In myrange
If c.Offset(-1, 0) <> "" Then

c.Insert Shift:=xlDown
End If
Next
Range("A1").Insert Shift:=xlDown
Range("C1").Insert Shift:=xlDown
Range("D1").Insert Shift:=xlDown
lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Set myrange = Range("A2:A" & lastrow)
For Each c In myrange
If c.Offset(, 1) <> "" Then
c.Offset(, 2).Insert Shift:=xlDown
c.Offset(, 3).Insert Shift:=xlDown
c.Insert Shift:=xlDown
End If
Next
End Sub


Mike
 
M

Mike H

Oops forgot to change this line

Columns("A:D").Sort Key1:=Range("B1"), Order1:=xlAscending

Mike
 
M

mwl

Hi Mike,

I really appreciate all the effort you are providing for this solution.

The code works brilliantly and I'm now trying to fit it into my worksheet in
the appropriate position. I've tried amending the code which I assume relates
to the destination. However, I think I've made a mistake somewhere as the
code is running and running!!

Firstly, do you know how to stop the code from running once it has started?

Secondly, do I need to change the code to cater for the following
requirements:

1) The original data contains header information in row 1. This header
information is not needed on the destination worksheet. However, does the
code need changing as the actual data that is needed starts in row 2?

2) The data being added to the destination worksheet needs to start in row
13 but in columns E, F, G and H. How do I change the code to cater for this?
 
M

Mike H

Hi,

To break an endless loop hold down the CTRL key and tap break. Click END in
the box that pops up

Try this. To correct the sheet names to what you want use the 'Replace
function in the VB editor.
Edit|replace

Just a general point it is considered good posting to ask the question you
want the answer to in the first place.

Sub sonic()
Sheets("Sheet1").Activate
lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Range("A2:A" & lastrow).Copy Destination:=Sheets("Sheet2").Range("F13")
Range("B2:B" & lastrow).Copy Destination:=Sheets("Sheet2").Range("E13")
Range("C2:C" & lastrow).Copy Destination:=Sheets("Sheet2").Range("G13")
Range("D2:D" & lastrow).Copy Destination:=Sheets("Sheet2").Range("H13")
Sheets("Sheet2").Activate
Range("E15:H" & lastrow + 13).Sort Key1:=Range("F13"), Order1:=xlAscending,
Header:=xlNo
lastrow = Cells(Cells.Rows.Count, "F").End(xlUp).Row
For x = 13 To lastrow
For y = x + 1 To lastrow
If Cells(x, 6) = Cells(y, 6) Then
Cells(y, 6).ClearContents
End If
Next
Next
Set myrange = Range("F14:f" & lastrow)
For Each c In myrange
If c.Offset(-1, 0) <> "" Then
c.Insert Shift:=xlDown
End If
Next
Range("E13").Insert Shift:=xlDown
Range("G13").Insert Shift:=xlDown
Range("H13").Insert Shift:=xlDown
lastrow = Cells(Cells.Rows.Count, "E").End(xlUp).Row
Set myrange = Range("E14:E" & lastrow)
For Each c In myrange
If c.Offset(, 1) <> "" Then
c.Offset(, 2).Insert Shift:=xlDown
c.Offset(, 3).Insert Shift:=xlDown
c.Insert Shift:=xlDown
End If
Next
End Sub

Mike
 
M

Mike H

bug removed

Sub sonic()
Sheets("Sheet1").Activate
lastrow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Range("A2:A" & lastrow).Copy Destination:=Sheets("Sheet2").Range("F13")
Range("B2:B" & lastrow).Copy Destination:=Sheets("Sheet2").Range("E13")
Range("C2:C" & lastrow).Copy Destination:=Sheets("Sheet2").Range("G13")
Range("D2:D" & lastrow).Copy Destination:=Sheets("Sheet2").Range("H13")
Sheets("Sheet2").Activate
Stop
Range("E13:H" & lastrow + 13).Sort Key1:=Range("F13"), Order1:=xlAscending,
Header:=xlNo
lastrow = Cells(Cells.Rows.Count, "F").End(xlUp).Row
For x = 13 To lastrow
For y = x + 1 To lastrow
If Cells(x, 6) = Cells(y, 6) Then
Cells(y, 6).ClearContents
End If
Next
Next
Set myrange = Range("F14:f" & lastrow)
For Each c In myrange
If c.Offset(-1, 0) <> "" Then
c.Insert Shift:=xlDown
End If
Next
Range("E13").Insert Shift:=xlDown
Range("G13").Insert Shift:=xlDown
Range("H13").Insert Shift:=xlDown
lastrow = Cells(Cells.Rows.Count, "E").End(xlUp).Row
Set myrange = Range("E14:E" & lastrow)
For Each c In myrange
If c.Offset(, 1) <> "" Then
c.Offset(, 2).Insert Shift:=xlDown
c.Offset(, 3).Insert Shift:=xlDown
c.Insert Shift:=xlDown
End If
Next
End Sub

Mike
 
M

mwl

Hi Mike,

Sorry about being more specific earlier. I thought it may have been easier
to explain the requirement in the way I did hoping that I'd be able to tweak
the solution accordingly.

I've had to make some minor amendments to the code as the worksheet data has
now altered!

When I run the following code, I get a "Compile Error: syntax error" which
highlights the row after the "Stop".

Sub sonic()
Sheets("Training List").Activate
lastrow = Cells(Cells.Rows.Count, "E").End(xlUp).Row
Range("E2:E" & lastrow).Copy Destination:=Sheets("Sheet2").Range("C13")
Range("F2:F" & lastrow).Copy Destination:=Sheets("Sheet2").Range("B13")
Range("G2:G" & lastrow).Copy Destination:=Sheets("Sheet2").Range("D13")
Range("H2:H" & lastrow).Copy Destination:=Sheets("Sheet2").Range("F13")
Sheets("Sheet2").Activate
Stop
Range("B13:F" & lastrow + 13).Sort Key1:=Range("C13"), Order1:=xlAscending,
Header:=xlNo
lastrow = Cells(Cells.Rows.Count, "C").End(xlUp).Row
For x = 13 To lastrow
For y = x + 1 To lastrow
If Cells(x, 6) = Cells(y, 6) Then
Cells(y, 6).ClearContents
End If
Next
Next
Set myrange = Range("C14:c" & lastrow)
For Each c In myrange
If c.Offset(-1, 0) <> "" Then
c.Insert Shift:=xlDown
End If
Next
Range("B13").Insert Shift:=xlDown
Range("D13").Insert Shift:=xlDown
Range("F13").Insert Shift:=xlDown
lastrow = Cells(Cells.Rows.Count, "B").End(xlUp).Row
Set myrange = Range("B14:B" & lastrow)
For Each c In myrange
If c.Offset(, 1) <> "" Then
c.Offset(, 2).Insert Shift:=xlDown
c.Offset(, 3).Insert Shift:=xlDown
c.Insert Shift:=xlDown
End If
Next
End Sub

Do you know what could be wrong?
 
J

Jarek Kujawa

try this one
assumes first names are in A column, surnames are in B
the result will be stored in C

select all yr first names in A column and run the macro:

Sub listeczka()
Dim cell As Range
Dim cel As Range
Dim counter As Integer
Dim ile As Integer

Range("C:D").ClearContents
counter = 0
ile = 0

For Each cell In Selection

If Application.WorksheetFunction.CountIf(Range("C:C"), cell) = 0
Then
ile = 0
For Each cel In Selection
If cel = cell Then
counter = counter + 1
If
Application.WorksheetFunction.CountIf(Range("C:C"), cel) = 0 Then
Cells(counter, 3) = cel
ile = ile + 1
Cells(counter + ile, 3) = cel.Offset(0, 1)
Else:
Cells(counter + ile, 3) = cel.Offset(0, 1)
End If
Else: GoTo next_cel
End If
next_cel:
Next cel
Else: GoTo next_cell
End If

counter = counter -
Application.WorksheetFunction.CountIf(Range("C:C"), cell) + 2

next_cell:
Next cell


End Sub

HIH
 
J

Jarek Kujawa

yet another one
will bold and underline first names
HIH


Sub listeczka()
Dim cell As Range
Dim cel As Range
Dim counter As Integer
Dim ile As Integer

Range("C:C").Clear
counter = 0
ile = 0

For Each cell In Selection

If Application.WorksheetFunction.CountIf(Range("C:C"), cell) = 0
Then
ile = 0
For Each cel In Selection
If cel = cell Then
counter = counter + 1
If
Application.WorksheetFunction.CountIf(Range("C:C"), cel) = 0 Then
With Cells(counter, 3)
.Value = cel
.Font.Bold = True
.Font.Underline = True
End With
ile = ile + 1
Cells(counter + ile, 3) = cel.Offset(0, 1)
Else:
Cells(counter + ile, 3) = cel.Offset(0, 1)
End If
Else: GoTo next_cel
End If
next_cel:
Next cel
Else: GoTo next_cell
End If

counter = counter -
Application.WorksheetFunction.CountIf(Range("C:C"), cell) + 2

next_cell:
Next cell


End Sub
 
M

mwl

Hi Mike,

I've resolved my syntax issue and it is all working perfectly now apart from
the final column (col F).

It only displays the unique values and on the incorrect rows.

For example, the data being read is:

E F G H
2 Mark Test 18-08-08 0.5
3 Mark Test 2 28-08-08 3
4 John Test 18-08-08 0.5
5 Mike Test 3 19-08-08 1

The result I'm now getting is:

B C D E F
13 John
14 Test 18-08-08 0.5
15 Mark 1
16 Test 18-08-08 3
17 Test2 25-08-08
18 Mike
19 Test3 19-08-08


The result I'd like to achieve is:

B C D E F
13 John
14 Test 18-08-08 0.5
15 Mark
16 Test 18-08-08 0.5
17 Test2 25-08-08 3
18 Mike
19 Test3 19-08-08 1
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Find a number in a column then return a value from another cell 2
How do I count once, multiple duplicate values? 1
Receive data in column with pull down 2
Return multiple values in one cell doing a single value lookup 4
passwords in fields... 0
PivotTable lookup 2
How would I do this merge 0
Real problem with SumProduct 2

Top