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: