macro; reorganize blocks of data

[anand]

I have data on individuals in rows of data. Some patients require just one
row of data from A to AZ. Others require 2 or 3 lines of data always A to AZ.

Each block of data is separated by 1 empty row. There are over 2000 blocks
of data (whether just 1 row, 2 rows, or 3 rows each).

I need a way to reorganize the data. If there is just one row of data, no
change required.
If 2 lines of data, the 2nd line should be arrayed (moved) from the 2nd row
A to AZ to 1st row BA to CZ (next to the first row of data) ie. so all data
is now on one line.

If there are 3 rows of data, the 2nd row would be as above. 3rd row would
also move to 1st row but would go to DA to EZ i.e. all 3 rows of data on 1st
line.

Doesn't matter if there are irregular intervals between lines of data (i.e.
1st rows can stay in same position).

I'll be grateful for any assistance.

Thanks

anand

 

[Lars-Åke Aspelin]

I have data on individuals in rows of data. Some patients require just one
row of data from A to AZ. Others require 2 or 3 lines of data always A to AZ.

Each block of data is separated by 1 empty row. There are over 2000 blocks
of data (whether just 1 row, 2 rows, or 3 rows each).

I need a way to reorganize the data. If there is just one row of data, no
change required.
If 2 lines of data, the 2nd line should be arrayed (moved) from the 2nd row
A to AZ to 1st row BA to CZ (next to the first row of data) ie. so all data
is now on one line.

If there are 3 rows of data, the 2nd row would be as above. 3rd row would
also move to 1st row but would go to DA to EZ i.e. all 3 rows of data on 1st
line.

Doesn't matter if there are irregular intervals between lines of data (i.e.
1st rows can stay in same position).

I'll be grateful for any assistance.

Thanks

anand

Try this:

Sub reorg_data(firstrow, lastrow, Optional blockwidth As Integer = 52)
Dim myrow As Integer
Dim mycol As Integer
Dim torow As Integer
Dim deletedrows As Integer
myrow = firstrow
With ActiveSheet
While myrow < lastrow - deletedrows
If .Cells(myrow, 1) <> "" Then
mycol = 1
torow = myrow
While Cells(myrow + 1, 1) <> ""
mycol = mycol + blockwidth
.Cells(myrow + 1, 1).Resize(1, blockwidth).Select
Selection.Cut
.Cells(torow, mycol).Select
.Paste
.Rows(myrow + 1).EntireRow.Delete shift:=xlUp
deletedrows = deletedrows + 1
Wend
End If
myrow = myrow + 1
Wend
.Cells(firstrow, 1).Select
End With
End Sub

Hope this helps / Lars-Åke

 

[anand]

I get an error when I run the macro.
The error I get when I run the macro is "Argument not optional"
Any ideas?

anand

 

[Lars-Åke Aspelin]

I get an error when I run the macro.
The error I get when I run the macro is "Argument not optional"
Any ideas?

anand

Maybe you forgot to give the two mandatory arguments firstrow and
lastrow when you called the sub reorg_data.

Try this macro to call the macro I suggested:

Sub test()
reorg_data 1,100
End Sub

Change 1 and 100 to the number of the first and last row in your
specific situation.

Hope this helps. / Lars-Åke