How do I Lookup next values in Excel?
 

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?

How do I Lookup next values in Excel?
 

I think you need to add a Macro.

Best Regards,
Jay

"mwl" wrote in message
...
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?

How do I Lookup next values in Excel?
 

Thanks Jay, but any clues as to how I do this?

"Jayarama Vytla" wrote:

I think you need to add a Macro.

Best Regards,
Jay

"mwl" wrote in message
...
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?

How do I Lookup next values in Excel?
 

Hi,

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

Best Regards,
Jay

"mwl" wrote in message
...
Thanks Jay, but any clues as to how I do this?

"Jayarama Vytla" wrote:

I think you need to add a Macro.

Best Regards,
Jay

"mwl" wrote in message
...
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?

How do I Lookup next values in Excel?
 

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

"mwl" wrote:

Thanks Jay, but any clues as to how I do this?

"Jayarama Vytla" wrote:

I think you need to add a Macro.

Best Regards,
Jay

"mwl" wrote in message
...
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?

How do I Lookup next values in Excel?
 

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 a

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

Any ideas how to change you code to achieve this?

"Mike H" wrote:

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

"mwl" wrote:

Thanks Jay, but any clues as to how I do this?

"Jayarama Vytla" wrote:

I think you need to add a Macro.

Best Regards,
Jay

"mwl" wrote in message
...
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?

How do I Lookup next values in Excel?
 

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

"mwl" wrote:

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 a

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

Any ideas how to change you code to achieve this?

"Mike H" wrote:

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

"mwl" wrote:

Thanks Jay, but any clues as to how I do this?

"Jayarama Vytla" wrote:

I think you need to add a Macro.

Best Regards,
Jay

"mwl" wrote in message
...
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?

How do I Lookup next values in Excel?
 

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 a

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


"Mike H" wrote:

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

"mwl" wrote:

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 a

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

Any ideas how to change you code to achieve this?

"Mike H" wrote:

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

"mwl" wrote:

Thanks Jay, but any clues as to how I do this?

"Jayarama Vytla" wrote:

I think you need to add a Macro.

Best Regards,
Jay

"mwl" wrote in message
...
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?

How do I Lookup next values in Excel?
 

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

"mwl" wrote:

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 a

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


"Mike H" wrote:

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

"mwl" wrote:

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 a

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

Any ideas how to change you code to achieve this?

"Mike H" wrote:

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

"mwl" wrote:

Thanks Jay, but any clues as to how I do this?

"Jayarama Vytla" wrote:

I think you need to add a Macro.

Best Regards,
Jay

"mwl" wrote in message
...
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?

How do I Lookup next values in Excel?
 

Oops forgot to change this line

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

Mike

"Mike H" wrote:

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

"mwl" wrote:

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 a

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


"Mike H" wrote:

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

"mwl" wrote:

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 a

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

Any ideas how to change you code to achieve this?

"Mike H" wrote:

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

"mwl" wrote:

Thanks Jay, but any clues as to how I do this?

"Jayarama Vytla" wrote:

I think you need to add a Macro.

Best Regards,
Jay

"mwl" wrote in message
...
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?

How do I Lookup next values in Excel?
 

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?




"Mike H" wrote:

Oops forgot to change this line

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

Mike

"Mike H" wrote:

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

"mwl" wrote:

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 a

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


"Mike H" wrote:

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

"mwl" wrote:

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 a

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

Any ideas how to change you code to achieve this?

"Mike H" wrote:

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

"mwl" wrote:

Thanks Jay, but any clues as to how I do this?

"Jayarama Vytla" wrote:

I think you need to add a Macro.

Best Regards,
Jay

"mwl" wrote in message
...
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?

How do I Lookup next values in Excel?
 

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


"mwl" wrote:

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?




"Mike H" wrote:

Oops forgot to change this line

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

Mike

"Mike H" wrote:

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

"mwl" wrote:

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 a

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


"Mike H" wrote:

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

"mwl" wrote:

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 a

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

Any ideas how to change you code to achieve this?

"Mike H" wrote:

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

"mwl" wrote:

Thanks Jay, but any clues as to how I do this?

"Jayarama Vytla" wrote:

I think you need to add a Macro.

Best Regards,
Jay

"mwl" wrote in message
...
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?

How do I Lookup next values in Excel?
 

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

"Mike H" wrote:

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


"mwl" wrote:

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?




"Mike H" wrote:

Oops forgot to change this line

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

Mike

"Mike H" wrote:

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

"mwl" wrote:

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 a

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


"Mike H" wrote:

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

"mwl" wrote:

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 a

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

Any ideas how to change you code to achieve this?

"Mike H" wrote:

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

"mwl" wrote:

Thanks Jay, but any clues as to how I do this?

"Jayarama Vytla" wrote:

I think you need to add a Macro.

Best Regards,
Jay

"mwl" wrote in message
...
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?

How do I Lookup next values in Excel?
 

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?


"Mike H" wrote:

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

"Mike H" wrote:

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


"mwl" wrote:

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?




"Mike H" wrote:

Oops forgot to change this line

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

Mike

"Mike H" wrote:

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

"mwl" wrote:

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 a

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


"Mike H" wrote:

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

"mwl" wrote:

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 a

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

Any ideas how to change you code to achieve this?

"Mike H" wrote:

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

"mwl" wrote:

How do I Lookup next values in Excel?
 

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

How do I Lookup next values in Excel?
 

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

How do I Lookup next values in Excel?
 

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



"Mike H" wrote:

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

"Mike H" wrote:

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


"mwl" wrote:

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?




"Mike H" wrote:

Oops forgot to change this line

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

Mike

"Mike H" wrote:

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

"mwl" wrote:

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 a

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


"Mike H" wrote:

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

"mwl" wrote:

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 a

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

Any ideas how to change you code to achieve this?

"Mike H" wrote:

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

"mwl" wrote: